[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 3259 - (download) (as text) (annotate)
Fri Jun 3 22:03:23 2005 UTC (14 years, 8 months ago) by dpvc
File size: 15398 byte(s)
Added a ->with() method that lets you set fields of a Parser object as
you create it.  For example:

    $f = Formula("sqrt(x)")->with(limits=>[0,3]);

or

    ANS(Formula("(x+1)/x")->with(checkUndefinedPoints=>1,test_at=>[[0]])->cmp);

or

    ANS($f->with(test_points=>[[0],[1],[2]])->cmp);

    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     checkUndefinedPoints => 0,
   46     max_undefined => undef,
   47   },
   48 );
   49 
   50 $context = \$defaultContext;
   51 
   52 
   53 #
   54 #  Precedence of the various types
   55 #    (They will be promoted upward automatically when needed)
   56 #
   57 $$context->{precedence} = {
   58    'Number'   =>  0,
   59    'Real'     =>  1,
   60    'Infinity' =>  2,
   61    'Complex'  =>  3,
   62    'Point'    =>  4,
   63    'Vector'   =>  5,
   64    'Matrix'   =>  6,
   65    'List'     =>  7,
   66    'Interval' =>  8,
   67    'Union'    =>  9,
   68    'String'   => 10,
   69    'Formula'  => 11,
   70    'special'  => 12,
   71 };
   72 
   73 #
   74 #  Binding of perl operator to class method
   75 #
   76 $$context->{method} = {
   77    '+'   => 'add',
   78    '-'   => 'sub',
   79    '*'   => 'mult',
   80    '/'   => 'div',
   81    '**'  => 'power',
   82    '.'   => '_dot',  # see _dot below
   83    'x'   => 'cross',
   84    '<=>' => 'compare',
   85    'cmp' => 'compare_string',
   86 };
   87 
   88 $$context->{pattern}{infinite} = '[-+]?inf(?:inity)?';
   89 $$context->{pattern}{infinity} = '\+?inf(?:inity)?';
   90 $$context->{pattern}{-infinity} = '-inf(?:inity)?';
   91 
   92 push(@{$$context->{data}{values}},'method','precedence');
   93 
   94 #############################################################
   95 
   96 #
   97 #  Check if a value is a number, complex, etc.
   98 #
   99 sub matchNumber   {my $n = shift; $n =~ m/^$$context->{pattern}{signedNumber}$/i}
  100 sub matchInfinite {my $n = shift; $n =~ m/^$$context->{pattern}{infinite}$/i}
  101 sub isReal    {class(shift) eq 'Real'}
  102 sub isComplex {class(shift) eq 'Complex'}
  103 sub isFormula {
  104   my $v = shift;
  105   return class($v) eq 'Formula' ||
  106          (ref($v) && ref($v) ne 'ARRAY' && $v->{isFormula});
  107 }
  108 sub isValue   {
  109   my $v = shift;
  110   return (ref($v) || $v) =~ m/^Value::/ ||
  111          (ref($v) && ref($v) ne 'ARRAY' && $v->{isValue});
  112 }
  113 
  114 sub isNumber {
  115   my $n = shift;
  116   return $n->{tree}->isNumber if isFormula($n);
  117   return isReal($n) || isComplex($n) || matchNumber($n);
  118 }
  119 
  120 sub isRealNumber {
  121   my $n = shift;
  122   return $n->{tree}->isRealNumber if isFormula($n);
  123   return isReal($n) || matchNumber($n);
  124 }
  125 
  126 sub isZero {
  127   my $self = shift;
  128   return 0 if scalar(@{$self->{data}}) == 0;
  129   foreach my $x (@{$self->{data}}) {return 0 unless $x eq "0"}
  130   return 1;
  131 }
  132 
  133 sub isOne {0}
  134 
  135 #
  136 #  Convert non-Value objects to Values, if possible
  137 #
  138 sub makeValue {
  139   my $x = shift; my %params = (showError => 0, makeFormula => 1, @_);
  140   return $x if ref($x) || $x eq '';
  141   return Value::Real->make($x) if matchNumber($x);
  142   if (matchInfinite($x)) {
  143     my $I = Value::Infinity->new();
  144     $I = $I->neg if $x =~ m/^$$Value::context->{pattern}{-infinity}$/;
  145     return $I;
  146   }
  147   return Value::String->make($x)
  148     if (!$Parser::installed || $$Value::context->{strings}{$x});
  149   return $x if !$params{makeFormula};
  150   Value::Error("String constant '$x' is not defined in this context")
  151     if $params{showError};
  152   $x = Value::Formula->new($x);
  153   $x = $x->eval if $x->isConstant;
  154   return $x;
  155 }
  156 
  157 #
  158 #  Get a printable version of the class of an object
  159 #
  160 sub showClass {
  161   my $value = makeValue(shift,makeFormula=>0);
  162   return "'".$value."'" unless Value::isValue($value);
  163   my $class = class($value);
  164   return showType($value) if ($class eq 'List');
  165   $class .= ' Number' if $class =~ m/^(Real|Complex)$/;
  166   $class .= ' of Intervals' if $class eq 'Union';
  167   $class = 'Word' if $class eq 'String';
  168   return 'a Formula that returns '.showType($value->{tree}) if ($class eq 'Formula');
  169   return 'an '.$class if $class =~ m/^[aeio]/i;
  170   return 'a '.$class;
  171 }
  172 
  173 #
  174 #  Get a printable version of the type of an object
  175 #
  176 sub showType {
  177   my $value = shift;
  178   my $type = $value->type;
  179   if ($type eq 'List') {
  180     my $ltype = $value->typeRef->{entryType}{name};
  181     if ($ltype && $ltype ne 'unknown') {
  182       $ltype =~ s/y$/ie/;
  183       $type .= ' of '.$ltype.'s';
  184     }
  185   }
  186   return 'a Word' if $type eq 'String';
  187   return 'a Complex Number' if $value->isComplex;
  188   return 'an '.$type if $type =~ m/^[aeio]/i;
  189   return 'a '.$type;
  190 }
  191 
  192 #
  193 #  Return a string describing a value's type
  194 #
  195 sub getType {
  196   my $equation = shift; my $value = shift;
  197   my $strings = $equation->{context}{strings};
  198   if (ref($value) eq 'ARRAY') {
  199     return 'Interval' if ($value->[0] =~ m/^[(\[]$/ && $value->[-1] =~ m/^[)\]]$/);
  200     my ($type,$ltype);
  201     foreach my $x (@{$value}) {
  202       $type = getType($equation,$x);
  203       if ($type eq 'value') {
  204         $type = $x->type if $x->class eq 'Formula';
  205         $type = 'Number' if $x->class eq 'Complex' || $type eq 'Complex';
  206       }
  207       $ltype = $type if $ltype eq '';
  208       return 'List' if $type ne $ltype;
  209     }
  210     return 'Point' if $ltype eq 'Number';
  211     return 'Matrix' if $ltype =~ m/Point|Matrix/;
  212     return 'List';
  213   }
  214   elsif (Value::isFormula($value)) {return 'Formula'}
  215   elsif (Value::class($value) eq 'Infinity') {return 'Infinity'}
  216   elsif (Value::isReal($value)) {return 'Number'}
  217   elsif (Value::isValue($value)) {return 'value'}
  218   elsif (ref($value)) {return 'unknown'}
  219   elsif (defined($strings->{$value})) {return 'String'}
  220   elsif (Value::isNumber($value)) {return 'Number'}
  221   return 'unknown';
  222 }
  223 
  224 #
  225 #  Get a string describing a value's type,
  226 #    and convert the value to a Value object (if needed)
  227 #
  228 sub getValueType {
  229   my $equation = shift; my $value = shift;
  230   my $type = Value::getType($equation,$value);
  231   if ($type eq 'String') {$type = $Value::Type{string}}
  232   elsif ($type eq 'Number') {$type = $Value::Type{number}}
  233   elsif ($type eq 'Infinity') {$type = $Value::Type{infinity}}
  234   elsif ($type eq 'value' || $type eq 'Formula') {$type = $value->typeRef}
  235   elsif ($type eq 'unknown') {
  236     $equation->Error("Can't convert ".Value::showClass($value)." to a constant");
  237   } else {
  238     $type = 'Value::'.$type, $value = $type->new(@{$value});
  239     $type = $value->typeRef;
  240   }
  241   return ($value,$type);
  242 }
  243 
  244 #
  245 #  Convert a list of values to a list of formulas (called by Parser::Value)
  246 #
  247 sub toFormula {
  248   my $formula = shift;
  249   my $processed = 0;
  250   my @f = (); my $vars = {};
  251   foreach my $x (@_) {
  252     if (isFormula($x)) {
  253       $formula->{context} = $x->{context}, $processed = 1 unless $processed;
  254       $formula->{variables} = {%{$formula->{variables}},%{$x->{variables}}};
  255       push(@f,$x->{tree}->copy($formula));
  256     } else {
  257       push(@f,$formula->{context}{parser}{Value}->new($formula,$x));
  258     }
  259   }
  260   return (@f);
  261 }
  262 
  263 #
  264 #  Convert a list of values (and open and close parens)
  265 #    to a formula whose type is the list type associated with
  266 #    the parens.
  267 #
  268 sub formula {
  269   my $self = shift; my $values = shift;
  270   my $class = $self->class;
  271   my $list = $$context->lists->get($class);
  272   my $open = $list->{'open'};
  273   my $close = $list->{'close'};
  274   my $paren = $open; $paren = 'list' if $class eq 'List';
  275   my $formula = Value::Formula->blank;
  276   my @coords = Value::toFormula($formula,@{$values});
  277   $formula->{tree} = $formula->{context}{parser}{List}->new($formula,[@coords],0,
  278      $formula->{context}{parens}{$paren},$coords[0]->typeRef,$open,$close);
  279   $formula->{autoFormula} = 1;  # mark that this was generated automatically
  280   return $formula;
  281 }
  282 
  283 #
  284 #  A shortcut for new() that creates an instance of the object,
  285 #    but doesn't do the error checking.  We assume the data are already
  286 #    known to be good.
  287 #
  288 sub make {
  289   my $self = shift; my $class = ref($self) || $self;
  290   bless {data => [@_]}, $class;
  291 }
  292 
  293 #
  294 #  Easy method for setting parameters of an object
  295 #
  296 sub with {
  297   my $self = shift; my %hash = @_;
  298   foreach my $id (keys(%hash)) {$self->{$id} = $hash{$id}}
  299   return $self;
  300 }
  301 
  302 #
  303 #  Return a type structure for the item
  304 #    (includes name, length of vectors, and so on)
  305 #
  306 sub Type {
  307   my $name = shift; my $length = shift; my $entryType = shift;
  308   $length = 1 unless defined $length;
  309   return {name => $name, length => $length, entryType => $entryType,
  310           list => (defined $entryType), @_};
  311 }
  312 
  313 #
  314 #  Some predefined types
  315 #
  316 %Type = (
  317   number   => Value::Type('Number',1),
  318   complex  => Value::Type('Number',2),
  319   string   => Value::Type('String',1),
  320   infinity => Value::Type('Infinity',1),
  321   unknown  => Value::Type('unknown',0,undef,list => 1)
  322 );
  323 
  324 #
  325 #  Return various information about the object
  326 #
  327 sub value {return @{(shift)->{data}}}                  # the value of the object (as an array)
  328 sub data {return (shift)->{data}}                      # the reference to the value
  329 sub length {return (shift)->typeRef->{length}}         # the number of coordinates
  330 sub type {return (shift)->typeRef->{name}}             # the object type
  331 sub entryType {return (shift)->typeRef->{entryType}}   # the coordinate type
  332 #
  333 #  The the full type-hash for the item
  334 #
  335 sub typeRef {
  336   my $self = shift;
  337   return Value::Type($self->class, $self->length, $Value::Type{number});
  338 }
  339 #
  340 #  The Value.pm object class
  341 #
  342 sub class {
  343   my $self = shift; my $class = ref($self) || $self;
  344   $class =~ s/.*:://;
  345   return $class;
  346 }
  347 
  348 #
  349 #  Get an element from a point, vector, matrix, or list
  350 #
  351 sub extract {
  352   my $M = shift; my $i; my @indices = @_;
  353   return unless Value::isValue($M);
  354   @indices = $_[0]->value if scalar(@_) == 1 && Value::isValue($_[0]);
  355   while (scalar(@indices) > 0) {
  356     $i = shift @indices; $i-- if $i > 0; $i = $i->value if Value::isValue($i);
  357     Value::Error("Can't extract element number '$i' (index must be an integer)")
  358       unless $i =~ m/^-?\d+$/;
  359     $M = $M->data->[$i];
  360   }
  361   return $M;
  362 }
  363 
  364 
  365 #
  366 #  Promote an operand to the same precedence as the current object
  367 #
  368 sub promotePrecedence {
  369   my $self = shift; my $other = shift;
  370   return 0 unless Value::isValue($other);
  371   my $sprec = $$context->{precedence}{class($self)};
  372   my $oprec = $$context->{precedence}{class($other)};
  373   return (defined($oprec) && $sprec < $oprec);
  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 compare_string {
  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 = shift; $frame = 2 unless defined($frame);
  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