[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 2621 - (download) (as text) (annotate)
Sun Aug 15 17:05:41 2004 UTC (15 years, 6 months ago) by dpvc
File size: 13639 byte(s)
Improved error messages, particularly when the student enters a
formula in an answer that should be constant, and also for incorrect
answers in lists of answers.  There are a few other miscellaneous output
improvements as well.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9