[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 2625 - (download) (as text) (annotate)
Mon Aug 16 18:35:12 2004 UTC (15 years, 3 months ago) by dpvc
File size: 13964 byte(s)
Added string comparison to all Value object classes (to compare the
string value of an object to another string).

Overloaded perl '.' operator to do dot product when the operands are
formulas returning vectors.  (Part of the auto-generation of
formulas).

A few improvements to real and complex class output results.

Made Union class slightly more robust and removed need for makeUnion
method other than in the Union itself.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9