[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 3192 - (download) (as text) (annotate)
Wed Mar 16 13:30:28 2005 UTC (14 years, 11 months ago) by dpvc
File size: 15160 byte(s)
Update the overloaded operators so that they can be overridden by
subclasses of the predefined object classes.  This involves calling
the objects method rather than using a hard reference to the routine
in the parent class.

Also, change the name of the string comparison routine to
compare_string to avoid conflicts with cmp that is used to produce the
answer checker for the class.

Finally, in Value.pm, promotePrecedence no longer has to do fancy
footwork to get "special" precedence to work (this was a hack to get
around the misfeature of the overloaded operators -- now that that is
being handled correctly, there is no need for it).

    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' => 'compare_string',
   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; my %params = (showError => 0, makeFormula => 1, @_);
  138   return $x if ref($x) || $x eq '';
  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   return Value::String->make($x)
  146     if (!$Parser::installed || $$Value::context->{strings}{$x});
  147   return $x if !$params{makeFormula};
  148   Value::Error("String constant '$x' is not defined in this context")
  149     if $params{showError};
  150   $x = Value::Formula->new($x);
  151   $x = $x->eval if $x->isConstant;
  152   return $x;
  153 }
  154 
  155 #
  156 #  Get a printable version of the class of an object
  157 #
  158 sub showClass {
  159   my $value = makeValue(shift,makeFormula=>0);
  160   return "'".$value."'" unless Value::isValue($value);
  161   my $class = class($value);
  162   return showType($value) if ($class eq 'List');
  163   $class .= ' Number' if $class =~ m/^(Real|Complex)$/;
  164   $class .= ' of Intervals' if $class eq 'Union';
  165   $class = 'Word' if $class eq 'String';
  166   return 'a Formula that returns '.showType($value->{tree}) if ($class eq 'Formula');
  167   return 'an '.$class if $class =~ m/^[aeio]/i;
  168   return 'a '.$class;
  169 }
  170 
  171 #
  172 #  Get a printable version of the type of an object
  173 #
  174 sub showType {
  175   my $value = shift;
  176   my $type = $value->type;
  177   if ($type eq 'List') {
  178     my $ltype = $value->typeRef->{entryType}{name};
  179     if ($ltype && $ltype ne 'unknown') {
  180       $ltype =~ s/y$/ie/;
  181       $type .= ' of '.$ltype.'s';
  182     }
  183   }
  184   return 'a Word' if $type eq 'String';
  185   return 'a Complex Number' if $value->isComplex;
  186   return 'an '.$type if $type =~ m/^[aeio]/i;
  187   return 'a '.$type;
  188 }
  189 
  190 #
  191 #  Return a string describing a value's type
  192 #
  193 sub getType {
  194   my $equation = shift; my $value = shift;
  195   my $strings = $equation->{context}{strings};
  196   if (ref($value) eq 'ARRAY') {
  197     return 'Interval' if ($value->[0] =~ m/^[(\[]$/ && $value->[-1] =~ m/^[)\]]$/);
  198     my ($type,$ltype);
  199     foreach my $x (@{$value}) {
  200       $type = getType($equation,$x);
  201       if ($type eq 'value') {
  202         $type = $x->type if $x->class eq 'Formula';
  203         $type = 'Number' if $x->class eq 'Complex' || $type eq 'Complex';
  204       }
  205       $ltype = $type if $ltype eq '';
  206       return 'List' if $type ne $ltype;
  207     }
  208     return 'Point' if $ltype eq 'Number';
  209     return 'Matrix' if $ltype =~ m/Point|Matrix/;
  210     return 'List';
  211   }
  212   elsif (Value::isFormula($value)) {return 'Formula'}
  213   elsif (Value::class($value) eq 'Infinity') {return 'Infinity'}
  214   elsif (Value::isReal($value)) {return 'Number'}
  215   elsif (Value::isValue($value)) {return 'value'}
  216   elsif (ref($value)) {return 'unknown'}
  217   elsif (defined($strings->{$value})) {return 'String'}
  218   elsif (Value::isNumber($value)) {return 'Number'}
  219   return 'unknown';
  220 }
  221 
  222 #
  223 #  Get a string describing a value's type,
  224 #    and convert the value to a Value object (if needed)
  225 #
  226 sub getValueType {
  227   my $equation = shift; my $value = shift;
  228   my $type = Value::getType($equation,$value);
  229   if ($type eq 'String') {$type = $Value::Type{string}}
  230   elsif ($type eq 'Number') {$type = $Value::Type{number}}
  231   elsif ($type eq 'Infinity') {$type = $Value::Type{infinity}}
  232   elsif ($type eq 'value' || $type eq 'Formula') {$type = $value->typeRef}
  233   elsif ($type eq 'unknown') {
  234     $equation->Error("Can't convert ".Value::showClass($value)." to a constant");
  235   } else {
  236     $type = 'Value::'.$type, $value = $type->new(@{$value});
  237     $type = $value->typeRef;
  238   }
  239   return ($value,$type);
  240 }
  241 
  242 #
  243 #  Convert a list of values to a list of formulas (called by Parser::Value)
  244 #
  245 sub toFormula {
  246   my $formula = shift;
  247   my $processed = 0;
  248   my @f = (); my $vars = {};
  249   foreach my $x (@_) {
  250     if (isFormula($x)) {
  251       $formula->{context} = $x->{context}, $processed = 1 unless $processed;
  252       $formula->{variables} = {%{$formula->{variables}},%{$x->{variables}}};
  253       push(@f,$x->{tree}->copy($formula));
  254     } else {
  255       push(@f,$formula->{context}{parser}{Value}->new($formula,$x));
  256     }
  257   }
  258   return (@f);
  259 }
  260 
  261 #
  262 #  Convert a list of values (and open and close parens)
  263 #    to a formula whose type is the list type associated with
  264 #    the parens.
  265 #
  266 sub formula {
  267   my $self = shift; my $values = shift;
  268   my $class = $self->class;
  269   my $list = $$context->lists->get($class);
  270   my $open = $list->{'open'};
  271   my $close = $list->{'close'};
  272   my $paren = $open; $paren = 'list' if $class eq 'List';
  273   my $formula = Value::Formula->blank;
  274   my @coords = Value::toFormula($formula,@{$values});
  275   $formula->{tree} = $formula->{context}{parser}{List}->new($formula,[@coords],0,
  276      $formula->{context}{parens}{$paren},$coords[0]->typeRef,$open,$close);
  277   $formula->{autoFormula} = 1;  # mark that this was generated automatically
  278   return $formula;
  279 }
  280 
  281 #
  282 #  A shortcut for new() that creates an instance of the object,
  283 #    but doesn't do the error checking.  We assume the data are already
  284 #    known to be good.
  285 #
  286 sub make {
  287   my $self = shift; my $class = ref($self) || $self;
  288   bless {data => [@_]}, $class;
  289 }
  290 
  291 #
  292 #  Return a type structure for the item
  293 #    (includes name, length of vectors, and so on)
  294 #
  295 sub Type {
  296   my $name = shift; my $length = shift; my $entryType = shift;
  297   $length = 1 unless defined $length;
  298   return {name => $name, length => $length, entryType => $entryType,
  299           list => (defined $entryType), @_};
  300 }
  301 
  302 #
  303 #  Some predefined types
  304 #
  305 %Type = (
  306   number   => Value::Type('Number',1),
  307   complex  => Value::Type('Number',2),
  308   string   => Value::Type('String',1),
  309   infinity => Value::Type('Infinity',1),
  310   unknown  => Value::Type('unknown',0,undef,list => 1)
  311 );
  312 
  313 #
  314 #  Return various information about the object
  315 #
  316 sub value {return @{(shift)->{data}}}                  # the value of the object (as an array)
  317 sub data {return (shift)->{data}}                      # the reference to the value
  318 sub length {return (shift)->typeRef->{length}}         # the number of coordinates
  319 sub type {return (shift)->typeRef->{name}}             # the object type
  320 sub entryType {return (shift)->typeRef->{entryType}}   # the coordinate type
  321 #
  322 #  The the full type-hash for the item
  323 #
  324 sub typeRef {
  325   my $self = shift;
  326   return Value::Type($self->class, $self->length, $Value::Type{number});
  327 }
  328 #
  329 #  The Value.pm object class
  330 #
  331 sub class {
  332   my $self = shift; my $class = ref($self) || $self;
  333   $class =~ s/.*:://;
  334   return $class;
  335 }
  336 
  337 #
  338 #  Get an element from a point, vector, matrix, or list
  339 #
  340 sub extract {
  341   my $M = shift; my $i; my @indices = @_;
  342   return unless Value::isValue($M);
  343   @indices = $_[0]->value if scalar(@_) == 1 && Value::isValue($_[0]);
  344   while (scalar(@indices) > 0) {
  345     $i = shift @indices; $i-- if $i > 0; $i = $i->value if Value::isValue($i);
  346     Value::Error("Can't extract element number '$i' (index must be an integer)")
  347       unless $i =~ m/^-?\d+$/;
  348     $M = $M->data->[$i];
  349   }
  350   return $M;
  351 }
  352 
  353 
  354 #
  355 #  Promote an operand to the same precedence as the current object
  356 #
  357 sub promotePrecedence {
  358   my $self = shift; my $other = shift;
  359   return 0 unless Value::isValue($other);
  360   my $sprec = $$context->{precedence}{class($self)};
  361   my $oprec = $$context->{precedence}{class($other)};
  362   return (defined($oprec) && $sprec < $oprec);
  363 }
  364 
  365 sub promote {shift}
  366 
  367 #
  368 #  Default stub to call when no function is defined for an operation
  369 #
  370 sub nomethod {
  371   my ($l,$r,$flag,$op) = @_;
  372   my $call = $$context->{method}{$op};
  373   if (defined($call) && $l->promotePrecedence($r)) {return $r->$call($l,!$flag)}
  374   my $error = "Can't use '$op' with ".$l->class."-valued operands";
  375   $error .= " (use '**' for exponentiation)" if $op eq '^';
  376   Value::Error($error);
  377 }
  378 
  379 #
  380 #  Stubs for the sub-classes
  381 #
  382 sub add   {nomethod(@_,'+')}
  383 sub sub   {nomethod(@_,'-')}
  384 sub mult  {nomethod(@_,'*')}
  385 sub div   {nomethod(@_,'/')}
  386 sub power {nomethod(@_,'**')}
  387 sub cross {nomethod(@_,'x')}
  388 
  389 #
  390 #  If the right operand is higher precedence, we switch the order.
  391 #
  392 #  If the right operand is also a Value object, we do the object's
  393 #  dot method to combine the two objects of the same class.
  394 #
  395 #  Otherwise, since . is used for string concatenation, we want to retain
  396 #  that.  Since the resulting string is often used in Formula and will be
  397 #  parsed again, we put parentheses around the values to guarantee that
  398 #  the values will be treated as one mathematical unit.  For example, if
  399 #  $f = Formula("1+x") and $g = Formula("y") then Formula("$f/$g") will be
  400 #  (1+x)/y not 1+(x/y), as it would be without the implicit parentheses.
  401 #
  402 sub _dot {
  403   my ($l,$r,$flag) = @_;
  404   return Value::_dot($r,$l,!$flag) if ($l->promotePrecedence($r));
  405   return $l->dot($r,$flag) if (Value::isValue($r));
  406   $l = $l->stringify; $l = '('.$l.')' unless $$Value::context->flag('StringifyAsTeX');
  407   return ($flag)? ($r.$l): ($l.$r);
  408 }
  409 #
  410 #  Some classes override this
  411 #
  412 sub dot {
  413   my ($l,$r,$flag) = @_;
  414   my $tex = $$Value::context->flag('StringifyAsTeX');
  415   $l = $l->stringify; $l = '('.$l.')' if $tex;
  416   if (ref($r)) {$r = $r->stringify; $r = '('.$l.')' if $tex}
  417   return ($flag)? ($r.$l): ($l.$r);
  418 }
  419 
  420 #
  421 #  Compare the values of the objects
  422 #    (list classes should replace this)
  423 #
  424 sub compare {
  425   my ($l,$r,$flag) = @_;
  426   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  427   return $l->value <=> $r->value;
  428 }
  429 
  430 #
  431 #  Compare the values as strings
  432 #
  433 sub compare_string {
  434   my ($l,$r,$flag) = @_;
  435   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  436   $l = $l->stringify; $r = $r->stringify if Value::isValue($r);
  437   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  438   return $l cmp $r;
  439 }
  440 
  441 #
  442 #  Generate the various output formats
  443 #  (can be replaced by sub-classes)
  444 #
  445 sub stringify {
  446   my $self = shift;
  447   return $self->TeX() if $$Value::context->flag('StringifyAsTeX');
  448   $self->string;
  449 }
  450 sub string {shift->value}
  451 sub TeX {shift->string(@_)}
  452 #
  453 #  For perl, call the appropriate constructor around the objects data
  454 #
  455 sub perl {
  456   my $self = shift; my $parens = shift; my $matrix = shift;
  457   my $class = $self->class; my $mtype = $class eq 'Matrix';
  458   my $perl; my @p = ();
  459   foreach my $x (@{$self->data}) {
  460     if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)}
  461   }
  462   @p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $class eq 'Interval';
  463   if ($matrix) {
  464     $perl = '['.join(',',@p).']';
  465   } else {
  466     $perl = $class.'('.join(',',@p).')';
  467     $perl = '('.$perl.')' if $parens == 1;
  468   }
  469   return $perl;
  470 }
  471 
  472 #
  473 #  Stubs for when called by Parser
  474 #
  475 sub eval {shift}
  476 sub reduce {shift}
  477 
  478 sub ijk {
  479   Value::Error("Can't use method 'ijk' with objects of type '".(shift)->class."'");
  480 }
  481 
  482 #
  483 #  Report an error
  484 #
  485 sub Error {
  486   my $message = shift;
  487   $$context->setError($message,'');
  488   die $message . traceback() if $$context->{debug};
  489   die $message . getCaller();
  490 }
  491 
  492 #
  493 #  Try to locate the line and file where the error occurred
  494 #
  495 sub getCaller {
  496   my $frame = 2;
  497   while (my ($pkg,$file,$line,$subname) = caller($frame++)) {
  498     return " at line $line of $file\n"
  499       unless $pkg =~ /^(Value|Parser)/ ||
  500              $subname =~ m/^(Value|Parser).*(new|call)$/;
  501   }
  502   return "";
  503 }
  504 
  505 #
  506 #  For debugging
  507 #
  508 sub traceback {
  509   my $frame = shift; $frame = 2 unless defined($frame);
  510   my $trace = '';
  511   while (my ($pkg,$file,$line,$subname) = caller($frame++))
  512     {$trace .= " in $subname at line $line of $file\n"}
  513   return $trace;
  514 }
  515 
  516 ###########################################################################
  517 #
  518 #  Load the sub-classes.
  519 #
  520 
  521 use Value::Real;
  522 use Value::Complex;
  523 use Value::Infinity;
  524 use Value::Point;
  525 use Value::Vector;
  526 use Value::Matrix;
  527 use Value::List;
  528 use Value::Interval;
  529 use Value::Union;
  530 use Value::String;
  531 use Value::Formula;
  532 
  533 use Value::WeBWorK;  # stuff specific to WeBWorK
  534 
  535 ###########################################################################
  536 
  537 use vars qw($installed);
  538 $Value::installed = 1;
  539 
  540 ###########################################################################
  541 ###########################################################################
  542 #
  543 #    To Do:
  544 #
  545 #  Make Complex class include more of Complex1.pm
  546 #  Make better interval comparison
  547 #  Include context in objects within new() calls.
  548 #
  549 ###########################################################################
  550 
  551 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9