[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 2592 - (download) (as text) (annotate)
Thu Aug 12 16:40:47 2004 UTC (15 years, 6 months ago) by dpvc
File size: 12055 byte(s)
A number of small fixes.  Most were to fix minor bugs in string and
TeX output, particulary for the various list-based objects (like
vectors, intervals, etc.).  There were also some bug fixes in the
comparison routines.  Some additional checks were added for valid
intervals when the coordinates are formulas.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9