[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 2664 - (download) (as text) (annotate)
Sat Aug 21 22:02:14 2004 UTC (15 years, 6 months ago) by dpvc
File size: 14475 byte(s)
Added a file to perform WeBWorK-specific modifications to the
Parser/Value packages.  (I've tried to make these independent of
WeBWorK, so you can use them in other perl code if you want to.)

The parameters for fuzzy reals and some of the other parameters now
are taken from the pg->{ansEvalDefaults} values (as defined in
global.conf or course.conf).  More still needs to be done with this,
however.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9