[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 3171 - (download) (as text) (annotate)
Tue Feb 15 21:53:23 2005 UTC (15 years ago) by dpvc
File size: 15212 byte(s)
Improved the Real(), Complex(), Point(), Vector(), Matrix() and
String() constructors so that they will process formulas passed to
them as strings rather than requiring perl objects for these.

For example, you can use Real("2/3") rather than Real(2/3) if you
want.  Also, Real("1+x") will return a formula returning a real
(essentially the same as Formula("1+x") in this case).

    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; 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/Value:://;
  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     ($sprec > $oprec && $sprec >= $$context->{precedence}{special});
  364 }
  365 
  366 sub promote {shift}
  367 
  368 #
  369 #  Default stub to call when no function is defined for an operation
  370 #
  371 sub nomethod {
  372   my ($l,$r,$flag,$op) = @_;
  373   my $call = $$context->{method}{$op};
  374   if (defined($call) && $l->promotePrecedence($r)) {return $r->$call($l,!$flag)}
  375   my $error = "Can't use '$op' with ".$l->class."-valued operands";
  376   $error .= " (use '**' for exponentiation)" if $op eq '^';
  377   Value::Error($error);
  378 }
  379 
  380 #
  381 #  Stubs for the sub-classes
  382 #
  383 sub add   {nomethod(@_,'+')}
  384 sub sub   {nomethod(@_,'-')}
  385 sub mult  {nomethod(@_,'*')}
  386 sub div   {nomethod(@_,'/')}
  387 sub power {nomethod(@_,'**')}
  388 sub cross {nomethod(@_,'x')}
  389 
  390 #
  391 #  If the right operand is higher precedence, we switch the order.
  392 #
  393 #  If the right operand is also a Value object, we do the object's
  394 #  dot method to combine the two objects of the same class.
  395 #
  396 #  Otherwise, since . is used for string concatenation, we want to retain
  397 #  that.  Since the resulting string is often used in Formula and will be
  398 #  parsed again, we put parentheses around the values to guarantee that
  399 #  the values will be treated as one mathematical unit.  For example, if
  400 #  $f = Formula("1+x") and $g = Formula("y") then Formula("$f/$g") will be
  401 #  (1+x)/y not 1+(x/y), as it would be without the implicit parentheses.
  402 #
  403 sub _dot {
  404   my ($l,$r,$flag) = @_;
  405   return Value::_dot($r,$l,!$flag) if ($l->promotePrecedence($r));
  406   return $l->dot($r,$flag) if (Value::isValue($r));
  407   $l = $l->stringify; $l = '('.$l.')' unless $$Value::context->flag('StringifyAsTeX');
  408   return ($flag)? ($r.$l): ($l.$r);
  409 }
  410 #
  411 #  Some classes override this
  412 #
  413 sub dot {
  414   my ($l,$r,$flag) = @_;
  415   my $tex = $$Value::context->flag('StringifyAsTeX');
  416   $l = $l->stringify; $l = '('.$l.')' if $tex;
  417   if (ref($r)) {$r = $r->stringify; $r = '('.$l.')' if $tex}
  418   return ($flag)? ($r.$l): ($l.$r);
  419 }
  420 
  421 #
  422 #  Compare the values of the objects
  423 #    (list classes should replace this)
  424 #
  425 sub compare {
  426   my ($l,$r,$flag) = @_;
  427   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  428   return $l->value <=> $r->value;
  429 }
  430 
  431 #
  432 #  Compare the values as strings
  433 #
  434 sub cmp {
  435   my ($l,$r,$flag) = @_;
  436   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  437   $l = $l->stringify; $r = $r->stringify if Value::isValue($r);
  438   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  439   return $l cmp $r;
  440 }
  441 
  442 #
  443 #  Generate the various output formats
  444 #  (can be replaced by sub-classes)
  445 #
  446 sub stringify {
  447   my $self = shift;
  448   return $self->TeX() if $$Value::context->flag('StringifyAsTeX');
  449   $self->string;
  450 }
  451 sub string {shift->value}
  452 sub TeX {shift->string(@_)}
  453 #
  454 #  For perl, call the appropriate constructor around the objects data
  455 #
  456 sub perl {
  457   my $self = shift; my $parens = shift; my $matrix = shift;
  458   my $class = $self->class; my $mtype = $class eq 'Matrix';
  459   my $perl; my @p = ();
  460   foreach my $x (@{$self->data}) {
  461     if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)}
  462   }
  463   @p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $class eq 'Interval';
  464   if ($matrix) {
  465     $perl = '['.join(',',@p).']';
  466   } else {
  467     $perl = $class.'('.join(',',@p).')';
  468     $perl = '('.$perl.')' if $parens == 1;
  469   }
  470   return $perl;
  471 }
  472 
  473 #
  474 #  Stubs for when called by Parser
  475 #
  476 sub eval {shift}
  477 sub reduce {shift}
  478 
  479 sub ijk {
  480   Value::Error("Can't use method 'ijk' with objects of type '".(shift)->class."'");
  481 }
  482 
  483 #
  484 #  Report an error
  485 #
  486 sub Error {
  487   my $message = shift;
  488   $$context->setError($message,'');
  489   die $message . traceback() if $$context->{debug};
  490   die $message . getCaller();
  491 }
  492 
  493 #
  494 #  Try to locate the line and file where the error occurred
  495 #
  496 sub getCaller {
  497   my $frame = 2;
  498   while (my ($pkg,$file,$line,$subname) = caller($frame++)) {
  499     return " at line $line of $file\n"
  500       unless $pkg =~ /^(Value|Parser)/ ||
  501              $subname =~ m/^(Value|Parser).*(new|call)$/;
  502   }
  503   return "";
  504 }
  505 
  506 #
  507 #  For debugging
  508 #
  509 sub traceback {
  510   my $frame = shift; $frame = 2 unless defined($frame);
  511   my $trace = '';
  512   while (my ($pkg,$file,$line,$subname) = caller($frame++))
  513     {$trace .= " in $subname at line $line of $file\n"}
  514   return $trace;
  515 }
  516 
  517 ###########################################################################
  518 #
  519 #  Load the sub-classes.
  520 #
  521 
  522 use Value::Real;
  523 use Value::Complex;
  524 use Value::Infinity;
  525 use Value::Point;
  526 use Value::Vector;
  527 use Value::Matrix;
  528 use Value::List;
  529 use Value::Interval;
  530 use Value::Union;
  531 use Value::String;
  532 use Value::Formula;
  533 
  534 use Value::WeBWorK;  # stuff specific to WeBWorK
  535 
  536 ###########################################################################
  537 
  538 use vars qw($installed);
  539 $Value::installed = 1;
  540 
  541 ###########################################################################
  542 ###########################################################################
  543 #
  544 #    To Do:
  545 #
  546 #  Make Complex class include more of Complex1.pm
  547 #  Make better interval comparison
  548 #  Include context in objects within new() calls.
  549 #
  550 ###########################################################################
  551 
  552 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9