[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 2603 - (download) (as text) (annotate)
Fri Aug 13 23:01:07 2004 UTC (15 years, 6 months ago) by dpvc
File size: 12804 byte(s)
Added an Infinite object class for the Value package.  Still need to
add it to the Parser package.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9