[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 2596 - (download) (as text) (annotate)
Thu Aug 12 23:11:32 2004 UTC (15 years, 6 months ago) by dpvc
File size: 12409 byte(s)
Have parser handle infinities better.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9