[system] / trunk / pg / lib / Value.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Value.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3166 - (download) (as text) (annotate)
Tue Feb 15 02:20:52 2005 UTC (15 years ago) by dpvc
File size: 15562 byte(s)
Fixed an error with Matrix() that could cause it to loop infinitely
when bad data is passed to it.

Also, allow Matrix(), Point(), Vector(), and Real() to accept string
values that are evaluated to produce the value returned.

(Sorry, accidentally committed with a blank message.)

    1 package Value;
    2 my $pkg = 'Value';
    3 use vars qw($context $defaultContext %Type);
    4 use strict;
    5 
    6 #############################################################
    7 #
    8 #  Initialize the context
    9 #
   10 
   11 use Value::Context;
   12 
   13 $defaultContext = Value::Context->new(
   14   lists => {
   15     'Point'  => {open => '(', close => ')'},
   16     'Vector' => {open => '<', close => '>'},
   17     'Matrix' => {open => '[', close => ']'},
   18     'List'   => {open => '(', close => ')'},
   19   },
   20   flags => {
   21     #
   22     #  For vectors:
   23     #
   24     ijk => 0,  # print vectors as <...>
   25     #
   26     #  word to use for infinity
   27     #
   28     infiniteWord => 'infinity',
   29     #
   30     #  For fuzzy reals:
   31     #
   32     useFuzzyReals => 1,
   33     tolerance    => 1E-4,
   34     tolType      => 'relative',
   35     zeroLevel    => 1E-14,
   36     zeroLevelTol => 1E-12,
   37     #
   38     #  For functions
   39     #
   40     limits      => [-2,2],
   41     num_points  => 5,
   42     granularity => 1000,
   43     resolution  => undef,
   44     max_adapt   => 1E8,
   45   },
   46 );
   47 
   48 $context = \$defaultContext;
   49 
   50 
   51 #
   52 #  Precedence of the various types
   53 #    (They will be promoted upward automatically when needed)
   54 #
   55 $$context->{precedence} = {
   56    'Number'   =>  0,
   57    'Real'     =>  1,
   58    'Infinity' =>  2,
   59    'Complex'  =>  3,
   60    'Point'    =>  4,
   61    'Vector'   =>  5,
   62    'Matrix'   =>  6,
   63    'List'     =>  7,
   64    'Interval' =>  8,
   65    'Union'    =>  9,
   66    'String'   => 10,
   67    'Formula'  => 11,
   68    'special'  => 12,
   69 };
   70 
   71 #
   72 #  Binding of perl operator to class method
   73 #
   74 $$context->{method} = {
   75    '+'   => 'add',
   76    '-'   => 'sub',
   77    '*'   => 'mult',
   78    '/'   => 'div',
   79    '**'  => 'power',
   80    '.'   => '_dot',  # see _dot below
   81    'x'   => 'cross',
   82    '<=>' => 'compare',
   83    'cmp' => 'cmp',
   84 };
   85 
   86 $$context->{pattern}{infinite} = '[-+]?inf(?:inity)?';
   87 $$context->{pattern}{infinity} = '\+?inf(?:inity)?';
   88 $$context->{pattern}{-infinity} = '-inf(?:inity)?';
   89 
   90 push(@{$$context->{data}{values}},'method','precedence');
   91 
   92 #############################################################
   93 
   94 #
   95 #  Check if a value is a number, complex, etc.
   96 #
   97 sub matchNumber   {my $n = shift; $n =~ m/^$$context->{pattern}{signedNumber}$/i}
   98 sub matchInfinite {my $n = shift; $n =~ m/^$$context->{pattern}{infinite}$/i}
   99 sub isReal    {class(shift) eq 'Real'}
  100 sub isComplex {class(shift) eq 'Complex'}
  101 sub isFormula {
  102   my $v = shift;
  103   return class($v) eq 'Formula' ||
  104          (ref($v) && ref($v) ne 'ARRAY' && $v->{isFormula});
  105 }
  106 sub isValue   {
  107   my $v = shift;
  108   return (ref($v) || $v) =~ m/^Value::/ ||
  109          (ref($v) && ref($v) ne 'ARRAY' && $v->{isValue});
  110 }
  111 
  112 sub isNumber {
  113   my $n = shift;
  114   return $n->{tree}->isNumber if isFormula($n);
  115   return isReal($n) || isComplex($n) || matchNumber($n);
  116 }
  117 
  118 sub isRealNumber {
  119   my $n = shift;
  120   return $n->{tree}->isRealNumber if isFormula($n);
  121   return isReal($n) || matchNumber($n);
  122 }
  123 
  124 sub isZero {
  125   my $self = shift;
  126   return 0 if scalar(@{$self->{data}}) == 0;
  127   foreach my $x (@{$self->{data}}) {return 0 unless $x eq "0"}
  128   return 1;
  129 }
  130 
  131 sub isOne {0}
  132 
  133 #
  134 #  Convert non-Value objects to Values, if possible
  135 #
  136 sub makeValue {
  137   my $x = shift;
  138   return $x if ref($x);
  139   return Value::Real->make($x) if matchNumber($x);
  140   if (matchInfinite($x)) {
  141     my $I = Value::Infinity->new();
  142     $I = $I->neg if $x =~ m/^$$Value::context->{pattern}{-infinity}$/;
  143     return $I;
  144   }
  145   if ($Parser::installed) {return $x unless $$Value::context->{strings}{$x}}
  146   return Value::String->make($x);
  147 }
  148 
  149 #
  150 #  Get a printable version of the class of an object
  151 #
  152 sub showClass {
  153   my $value = makeValue(shift);
  154   return "'".$value."'" unless Value::isValue($value);
  155   my $class = class($value);
  156   return showType($value) if ($class eq 'List');
  157   $class .= ' Number' if $class =~ m/^(Real|Complex)$/;
  158   $class .= ' of Intervals' if $class eq 'Union';
  159   $class = 'Word' if $class eq 'String';
  160   return 'a Formula that returns '.showType($value->{tree}) if ($class eq 'Formula');
  161   return 'an '.$class if $class =~ m/^[aeio]/i;
  162   return 'a '.$class;
  163 }
  164 
  165 #
  166 #  Get a printable version of the type of an object
  167 #
  168 sub showType {
  169   my $value = shift;
  170   my $type = $value->type;
  171   if ($type eq 'List') {
  172     my $ltype = $value->typeRef->{entryType}{name};
  173     if ($ltype && $ltype ne 'unknown') {
  174       $ltype =~ s/y$/ie/;
  175       $type .= ' of '.$ltype.'s';
  176     }
  177   }
  178   return 'a Word' if $type eq 'String';
  179   return 'a Complex Number' if $value->isComplex;
  180   return 'an '.$type if $type =~ m/^[aeio]/i;
  181   return 'a '.$type;
  182 }
  183 
  184 #
  185 #  Return a string describing a value's type
  186 #
  187 sub getType {
  188   my $equation = shift; my $value = shift;
  189   my $strings = $equation->{context}{strings};
  190   if (ref($value) eq 'ARRAY') {
  191     return 'Interval' if ($value->[0] =~ m/^[(\[]$/ && $value->[-1] =~ m/^[)\]]$/);
  192     my ($type,$ltype);
  193     foreach my $x (@{$value}) {
  194       $type = getType($equation,$x);
  195       if ($type eq 'value') {
  196         $type = $x->type if $x->class eq 'Formula';
  197         $type = 'Number' if $x->class eq 'Complex' || $type eq 'Complex';
  198       }
  199       $ltype = $type if $ltype eq '';
  200       return 'List' if $type ne $ltype;
  201     }
  202     return 'Point' if $ltype eq 'Number';
  203     return 'Matrix' if $ltype =~ m/Point|Matrix/;
  204     return 'List';
  205   }
  206   elsif (Value::isFormula($value)) {return 'Formula'}
  207   elsif (Value::class($value) eq 'Infinity') {return 'Infinity'}
  208   elsif (Value::isReal($value)) {return 'Number'}
  209   elsif (Value::isValue($value)) {return 'value'}
  210   elsif (ref($value)) {return 'unknown'}
  211   elsif (defined($strings->{$value})) {return 'String'}
  212   elsif (Value::isNumber($value)) {return 'Number'}
  213   return 'unknown';
  214 }
  215 
  216 #
  217 #  Get a string describing a value's type,
  218 #    and convert the value to a Value object (if needed)
  219 #
  220 sub getValueType {
  221   my $equation = shift; my $value = shift;
  222   my $type = Value::getType($equation,$value);
  223   if ($type eq 'String') {$type = $Value::Type{string}}
  224   elsif ($type eq 'Number') {$type = $Value::Type{number}}
  225   elsif ($type eq 'Infinity') {$type = $Value::Type{infinity}}
  226   elsif ($type eq 'value' || $type eq 'Formula') {$type = $value->typeRef}
  227   elsif ($type eq 'unknown') {
  228     $equation->Error("Can't convert ".Value::showClass($value)." to a constant");
  229   } else {
  230     $type = 'Value::'.$type, $value = $type->new(@{$value});
  231     $type = $value->typeRef;
  232   }
  233   return ($value,$type);
  234 }
  235 
  236 #
  237 #  Convert a list of values to a list of formulas (called by Parser::Value)
  238 #
  239 sub toFormula {
  240   my $formula = shift;
  241   my $processed = 0;
  242   my @f = (); my $vars = {};
  243   foreach my $x (@_) {
  244     if (isFormula($x)) {
  245       $formula->{context} = $x->{context}, $processed = 1 unless $processed;
  246       $formula->{variables} = {%{$formula->{variables}},%{$x->{variables}}};
  247       push(@f,$x->{tree}->copy($formula));
  248     } else {
  249       push(@f,$formula->{context}{parser}{Value}->new($formula,$x));
  250     }
  251   }
  252   return (@f);
  253 }
  254 
  255 #
  256 #  Convert a list of values (and open and close parens)
  257 #    to a formula whose type is the list type associated with
  258 #    the parens.  If the formula is constant, evaluate it.
  259 #
  260 sub formula {
  261   my $self = shift; my $values = shift;
  262   my $class = $self->class;
  263   my $list = $$context->lists->get($class);
  264   my $open = $list->{'open'};
  265   my $close = $list->{'close'};
  266   my $paren = $open; $paren = 'list' if $class eq 'List';
  267   my $formula = Value::Formula->blank;
  268   my @coords = Value::toFormula($formula,@{$values});
  269   $formula->{tree} = $formula->{context}{parser}{List}->new($formula,[@coords],0,
  270      $formula->{context}{parens}{$paren},$coords[0]->typeRef,$open,$close);
  271   $formula->{autoFormula} = 1;  # mark that this was generated automatically
  272 #   return $formula->eval if scalar(%{$formula->{variables}}) == 0;
  273   return $formula;
  274 }
  275 
  276 #
  277 #  Parse a string and return the resulting formula if it of the right
  278 #  type.  If the formula is constant, return the value rather than the
  279 #  formula.
  280 #
  281 sub parseFormula {
  282   my $self = shift; my $class = ref($self) ? $self->type : class($self);
  283   $class = "Number" if $class eq 'Real' || $class eq "Complex";
  284   my $f = (scalar(@_) > 1) ? join(',',@_) : shift;
  285   $f = Value::Formula->new($f); $f = $f->eval() if $f->isConstant;
  286   Value::Error("Can't convert ".Value::showClass($f)." to ".Value::showClass($self))
  287     if ($f->type ne $class);
  288   return $f;
  289 }
  290 
  291 #
  292 #  A shortcut for new() that creates an instance of the object,
  293 #    but doesn't do the error checking.  We assume the data are already
  294 #    known to be good.
  295 #
  296 sub make {
  297   my $self = shift; my $class = ref($self) || $self;
  298   bless {data => [@_]}, $class;
  299 }
  300 
  301 #
  302 #  Return a type structure for the item
  303 #    (includes name, length of vectors, and so on)
  304 #
  305 sub Type {
  306   my $name = shift; my $length = shift; my $entryType = shift;
  307   $length = 1 unless defined $length;
  308   return {name => $name, length => $length, entryType => $entryType,
  309           list => (defined $entryType), @_};
  310 }
  311 
  312 #
  313 #  Some predefined types
  314 #
  315 %Type = (
  316   number   => Value::Type('Number',1),
  317   complex  => Value::Type('Number',2),
  318   string   => Value::Type('String',1),
  319   infinity => Value::Type('Infinity',1),
  320   unknown  => Value::Type('unknown',0,undef,list => 1)
  321 );
  322 
  323 #
  324 #  Return various information about the object
  325 #
  326 sub value {return @{(shift)->{data}}}                  # the value of the object (as an array)
  327 sub data {return (shift)->{data}}                      # the reference to the value
  328 sub length {return (shift)->typeRef->{length}}         # the number of coordinates
  329 sub type {return (shift)->typeRef->{name}}             # the object type
  330 sub entryType {return (shift)->typeRef->{entryType}}   # the coordinate type
  331 #
  332 #  The the full type-hash for the item
  333 #
  334 sub typeRef {
  335   my $self = shift;
  336   return Value::Type($self->class, $self->length, $Value::Type{number});
  337 }
  338 #
  339 #  The Value.pm object class
  340 #
  341 sub class {
  342   my $self = shift; my $class = ref($self) || $self;
  343   $class =~ s/Value:://;
  344   return $class;
  345 }
  346 
  347 #
  348 #  Get an element from a point, vector, matrix, or list
  349 #
  350 sub extract {
  351   my $M = shift; my $i; my @indices = @_;
  352   return unless Value::isValue($M);
  353   @indices = $_[0]->value if scalar(@_) == 1 && Value::isValue($_[0]);
  354   while (scalar(@indices) > 0) {
  355     $i = shift @indices; $i-- if $i > 0; $i = $i->value if Value::isValue($i);
  356     Value::Error("Can't extract element number '$i' (index must be an integer)")
  357       unless $i =~ m/^-?\d+$/;
  358     $M = $M->data->[$i];
  359   }
  360   return $M;
  361 }
  362 
  363 
  364 #
  365 #  Promote an operand to the same precedence as the current object
  366 #
  367 sub promotePrecedence {
  368   my $self = shift; my $other = shift;
  369   return 0 unless Value::isValue($other);
  370   my $sprec = $$context->{precedence}{class($self)};
  371   my $oprec = $$context->{precedence}{class($other)};
  372   return (defined($oprec) && $sprec < $oprec) ||
  373     ($sprec > $oprec && $sprec >= $$context->{precedence}{special});
  374 }
  375 
  376 sub promote {shift}
  377 
  378 #
  379 #  Default stub to call when no function is defined for an operation
  380 #
  381 sub nomethod {
  382   my ($l,$r,$flag,$op) = @_;
  383   my $call = $$context->{method}{$op};
  384   if (defined($call) && $l->promotePrecedence($r)) {return $r->$call($l,!$flag)}
  385   my $error = "Can't use '$op' with ".$l->class."-valued operands";
  386   $error .= " (use '**' for exponentiation)" if $op eq '^';
  387   Value::Error($error);
  388 }
  389 
  390 #
  391 #  Stubs for the sub-classes
  392 #
  393 sub add   {nomethod(@_,'+')}
  394 sub sub   {nomethod(@_,'-')}
  395 sub mult  {nomethod(@_,'*')}
  396 sub div   {nomethod(@_,'/')}
  397 sub power {nomethod(@_,'**')}
  398 sub cross {nomethod(@_,'x')}
  399 
  400 #
  401 #  If the right operand is higher precedence, we switch the order.
  402 #
  403 #  If the right operand is also a Value object, we do the object's
  404 #  dot method to combine the two objects of the same class.
  405 #
  406 #  Otherwise, since . is used for string concatenation, we want to retain
  407 #  that.  Since the resulting string is often used in Formula and will be
  408 #  parsed again, we put parentheses around the values to guarantee that
  409 #  the values will be treated as one mathematical unit.  For example, if
  410 #  $f = Formula("1+x") and $g = Formula("y") then Formula("$f/$g") will be
  411 #  (1+x)/y not 1+(x/y), as it would be without the implicit parentheses.
  412 #
  413 sub _dot {
  414   my ($l,$r,$flag) = @_;
  415   return Value::_dot($r,$l,!$flag) if ($l->promotePrecedence($r));
  416   return $l->dot($r,$flag) if (Value::isValue($r));
  417   $l = $l->stringify; $l = '('.$l.')' unless $$Value::context->flag('StringifyAsTeX');
  418   return ($flag)? ($r.$l): ($l.$r);
  419 }
  420 #
  421 #  Some classes override this
  422 #
  423 sub dot {
  424   my ($l,$r,$flag) = @_;
  425   my $tex = $$Value::context->flag('StringifyAsTeX');
  426   $l = $l->stringify; $l = '('.$l.')' if $tex;
  427   if (ref($r)) {$r = $r->stringify; $r = '('.$l.')' if $tex}
  428   return ($flag)? ($r.$l): ($l.$r);
  429 }
  430 
  431 #
  432 #  Compare the values of the objects
  433 #    (list classes should replace this)
  434 #
  435 sub compare {
  436   my ($l,$r,$flag) = @_;
  437   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  438   return $l->value <=> $r->value;
  439 }
  440 
  441 #
  442 #  Compare the values as strings
  443 #
  444 sub cmp {
  445   my ($l,$r,$flag) = @_;
  446   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  447   $l = $l->stringify; $r = $r->stringify if Value::isValue($r);
  448   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  449   return $l cmp $r;
  450 }
  451 
  452 #
  453 #  Generate the various output formats
  454 #  (can be replaced by sub-classes)
  455 #
  456 sub stringify {
  457   my $self = shift;
  458   return $self->TeX() if $$Value::context->flag('StringifyAsTeX');
  459   $self->string;
  460 }
  461 sub string {shift->value}
  462 sub TeX {shift->string(@_)}
  463 #
  464 #  For perl, call the appropriate constructor around the objects data
  465 #
  466 sub perl {
  467   my $self = shift; my $parens = shift; my $matrix = shift;
  468   my $class = $self->class; my $mtype = $class eq 'Matrix';
  469   my $perl; my @p = ();
  470   foreach my $x (@{$self->data}) {
  471     if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)}
  472   }
  473   @p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $class eq 'Interval';
  474   if ($matrix) {
  475     $perl = '['.join(',',@p).']';
  476   } else {
  477     $perl = $class.'('.join(',',@p).')';
  478     $perl = '('.$perl.')' if $parens == 1;
  479   }
  480   return $perl;
  481 }
  482 
  483 #
  484 #  Stubs for when called by Parser
  485 #
  486 sub eval {shift}
  487 sub reduce {shift}
  488 
  489 sub ijk {
  490   Value::Error("Can't use method 'ijk' with objects of type '".(shift)->class."'");
  491 }
  492 
  493 #
  494 #  Report an error
  495 #
  496 sub Error {
  497   my $message = shift;
  498   $$context->setError($message,'');
  499   die $message . traceback() if $$context->{debug};
  500   die $message . getCaller();
  501 }
  502 
  503 #
  504 #  Try to locate the line and file where the error occurred
  505 #
  506 sub getCaller {
  507   my $frame = 2;
  508   while (my ($pkg,$file,$line,$subname) = caller($frame++)) {
  509     return " at line $line of $file\n"
  510       unless $pkg =~ /^(Value|Parser)/ ||
  511              $subname =~ m/^(Value|Parser).*(new|call)$/;
  512   }
  513   return "";
  514 }
  515 
  516 #
  517 #  For debugging
  518 #
  519 sub traceback {
  520   my $frame = 2;
  521   my $trace = '';
  522   while (my ($pkg,$file,$line,$subname) = caller($frame++))
  523     {$trace .= " in $subname at line $line of $file\n"}
  524   return $trace;
  525 }
  526 
  527 ###########################################################################
  528 #
  529 #  Load the sub-classes.
  530 #
  531 
  532 use Value::Real;
  533 use Value::Complex;
  534 use Value::Infinity;
  535 use Value::Point;
  536 use Value::Vector;
  537 use Value::Matrix;
  538 use Value::List;
  539 use Value::Interval;
  540 use Value::Union;
  541 use Value::String;
  542 use Value::Formula;
  543 
  544 use Value::WeBWorK;  # stuff specific to WeBWorK
  545 
  546 ###########################################################################
  547 
  548 use vars qw($installed);
  549 $Value::installed = 1;
  550 
  551 ###########################################################################
  552 ###########################################################################
  553 #
  554 #    To Do:
  555 #
  556 #  Make Complex class include more of Complex1.pm
  557 #  Make better interval comparison
  558 #  Include context in objects within new() calls.
  559 #
  560 ###########################################################################
  561 
  562 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9