[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 2801 - (download) (as text) (annotate)
Sun Sep 19 14:41:57 2004 UTC (15 years, 4 months ago) by dpvc
File size: 14959 byte(s)
More changes for the isZero and isOne checks.  (Missed this file when
I committed the others.)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9