[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 5112 - (download) (as text) (annotate)
Mon Jul 2 16:18:49 2007 UTC (12 years, 7 months ago) by dpvc
File size: 27251 byte(s)
Make getFlag() look for an {equation} field and add that into the
search path for the flag.  This lets Formula object tag their results
so that printing and comparisons will use the flags from the Formula
for formats and tolerances.

    1 package Value;
    2 my $pkg = 'Value';
    3 use vars qw($context $defaultContext %Type);
    4 use strict;
    5 
    6 =head1 DESCRIPTION
    7 
    8 Value (also called MathObjects) are intelligent versions of standard mathematical
    9 objects.  They 'know' how to produce string or TeX or perl representations
   10 of themselves.  They also 'know' how to compare themselves to student responses --
   11 in other words they contain their own answer evaluators (response evaluators).
   12 The standard operators like +, -, *, <, ==, >, etc, all work with them (when they
   13 make sense), so that you can use these MathObjects in a natural way.  The comparisons
   14 like equality are "fuzzy", meaning that two items are equal when they are "close enough"
   15 (by tolerances that are set in the current Context).
   16 
   17 =cut
   18 
   19 
   20 =head3 Value context
   21 
   22  #############################################################
   23  #
   24  #  Initialize the context-- flags set
   25  #
   26   The following are list objects, meaning that they involve delimiters (parentheses)
   27   of some type.
   28 
   29   lists => {
   30     'Point'  => {open => '(', close => ')'},
   31     'Vector' => {open => '<', close => '>'},
   32     'Matrix' => {open => '[', close => ']'},
   33     'List'   => {open => '(', close => ')'},
   34     'Set'    => {open => '{', close => '}'},
   35     },
   36 
   37   The following context flags are set:
   38 
   39     #  For vectors:
   40     #
   41     ijk => 0,  # print vectors as <...>
   42     #
   43     #  For strings:
   44     #
   45     allowEmptyStrings => 1,
   46     infiniteWord => 'infinity',
   47     #
   48     #  For intervals and unions:
   49     #
   50     ignoreEndpointTypes => 0,
   51     reduceSets => 1,
   52     reduceSetsForComparison => 1,
   53     reduceUnions => 1,
   54     reduceUnionsForComparison => 1,
   55     #
   56     #  For fuzzy reals:
   57     #
   58     useFuzzyReals => 1,
   59     tolerance    => 1E-4,
   60     tolType      => 'relative',
   61     zeroLevel    => 1E-14,
   62     zeroLevelTol => 1E-12,
   63     #
   64     #  For Formulas:
   65     #
   66     limits       => [-2,2],
   67     num_points   => 5,
   68     granularity  => 1000,
   69     resolution   => undef,
   70     max_adapt    => 1E8,
   71     checkUndefinedPoints => 0,
   72     max_undefined => undef,
   73   },
   74 
   75 
   76 =cut
   77 
   78 BEGIN {
   79 
   80 use Value::Context;
   81 
   82 $defaultContext = Value::Context->new(
   83   lists => {
   84     'Point'  => {open => '(', close => ')'},
   85     'Vector' => {open => '<', close => '>'},
   86     'Matrix' => {open => '[', close => ']'},
   87     'List'   => {open => '(', close => ')'},
   88     'Set'    => {open => '{', close => '}'},
   89   },
   90   flags => {
   91     #
   92     #  For vectors:
   93     #
   94     ijk => 0,  # print vectors as <...>
   95     #
   96     #  For strings:
   97     #
   98     allowEmptyStrings => 1,
   99     infiniteWord => 'infinity',
  100     #
  101     #  For intervals and unions:
  102     #
  103     ignoreEndpointTypes => 0,
  104     reduceSets => 1,
  105     reduceSetsForComparison => 1,
  106     reduceUnions => 1,
  107     reduceUnionsForComparison => 1,
  108     #
  109     #  For fuzzy reals:
  110     #
  111     useFuzzyReals => 1,
  112     tolerance    => 1E-4,
  113     tolType      => 'relative',
  114     zeroLevel    => 1E-14,
  115     zeroLevelTol => 1E-12,
  116     #
  117     #  For Formulas:
  118     #
  119     limits       => [-2,2],
  120     num_points   => 5,
  121     granularity  => 1000,
  122     resolution   => undef,
  123     max_adapt    => 1E8,
  124     checkUndefinedPoints => 0,
  125     max_undefined => undef,
  126   },
  127 );
  128 
  129 $context = \$defaultContext;
  130 
  131 }
  132 
  133 =head3 Implemented MathObject types and their precedence
  134 
  135  #
  136  #  Precedence of the various types
  137  #    (They will be promoted upward automatically when needed)
  138  #
  139 
  140   'Number'   =>  0,
  141    'Real'     =>  1,
  142    'Infinity' =>  2,
  143    'Complex'  =>  3,
  144    'Point'    =>  4,
  145    'Vector'   =>  5,
  146    'Matrix'   =>  6,
  147    'List'     =>  7,
  148    'Interval' =>  8,
  149    'Set'      =>  9,
  150    'Union'    => 10,
  151    'String'   => 11,
  152    'Formula'  => 12,
  153    'special'  => 20,
  154 
  155 =cut
  156 
  157 $$context->{precedence} = {
  158    'Number'   =>  0,
  159    'Real'     =>  1,
  160    'Infinity' =>  2,
  161    'Complex'  =>  3,
  162    'Point'    =>  4,
  163    'Vector'   =>  5,
  164    'Matrix'   =>  6,
  165    'List'     =>  7,
  166    'Interval' =>  8,
  167    'Set'      =>  9,
  168    'Union'    => 10,
  169    'String'   => 11,
  170    'Formula'  => 12,
  171    'special'  => 20,
  172 };
  173 
  174 #
  175 #  Binding of perl operator to class method
  176 #
  177 $$context->{method} = {
  178    '+'   => 'add',
  179    '-'   => 'sub',
  180    '*'   => 'mult',
  181    '/'   => 'div',
  182    '**'  => 'power',
  183    '.'   => '_dot',       # see _dot below
  184    'x'   => 'cross',
  185    '%'   => 'modulo',
  186    '<=>' => 'compare',
  187    'cmp' => 'compare_string',
  188 };
  189 
  190 $$context->{pattern}{infinite} = '[-+]?inf(?:inity)?';
  191 $$context->{pattern}{infinity} = '\+?inf(?:inity)?';
  192 $$context->{pattern}{-infinity} = '-inf(?:inity)?';
  193 
  194 push(@{$$context->{data}{values}},'method','precedence');
  195 
  196 #
  197 #  Copy a context and its data
  198 #
  199 sub copy {
  200   my $self = shift;
  201   my $copy = {%{$self}}; $copy->{data} = [@{$self->{data}}];
  202   foreach my $x (@{$copy->{data}}) {$x = $x->copy if Value::isValue($x)}
  203   return bless $copy, ref($self);
  204 }
  205 
  206 =head3 getFlag
  207 
  208 #
  209 #  Get the value of a flag from the object itself,
  210 #  or from the context, or from the default context
  211 #  or from the given default, whichever is found first.
  212 #
  213 
  214   Usage:   $mathObj->getFlag("showTypeWarnings");
  215            $mathObj->getFlag("showTypeWarnings",1); # default is second parameter
  216 
  217 =cut
  218 
  219 sub getFlag {
  220   my $self = shift; my $name = shift;
  221   if (ref($self) && ref($self) ne 'ARRAY') {
  222     return $self->{$name} if defined($self->{$name});
  223     return $self->{equation}{$name} if defined($self->{equation}) && defined($self->{equation}{$name});
  224   }
  225   my $context = $self->context;
  226   return $context->{answerHash}{$name}
  227     if defined($context->{answerHash}) && defined($context->{answerHash}{$name});  # use WW answerHash flags first
  228   return $context->{flags}{$name} if defined($context->{flags}{$name});
  229   return shift;
  230 }
  231 
  232 #
  233 #  Get or set the context of an object
  234 #
  235 sub context {
  236   my $self = shift; my $context = shift;
  237   if (ref($self) && ref($self) ne 'ARRAY') {
  238     if ($context && $self->{context} != $context) {
  239       $self->{context} = $context;
  240       if (defined $self->{data}) {
  241         foreach my $x (@{$self->{data}}) {$x->context($context) if ref($x)}
  242       }
  243     }
  244     return $self->{context} if $self->{context};
  245   }
  246   return $$Value::context;
  247 }
  248 
  249 #
  250 #  Set context but return object
  251 #
  252 sub inContext {my $self = shift; $self->context(@_); $self}
  253 
  254 
  255 #############################################################
  256 
  257 #
  258 #  Check if the object class matches one of a list of classes
  259 #
  260 sub classMatch {
  261   my $self = shift; my $class = class($self);
  262   my $ref = ref($self); my $isHash = ($ref && $ref ne 'ARRAY' && $ref ne 'CODE');
  263   my $context = ($isHash ? $self->{context} || Value->context : Value->context);
  264   foreach my $name (@_) {
  265     return 1 if $class eq $name || $ref eq $context->Package($name,1) ||
  266                 $ref eq "Value::$name" || ($isHash && $self->{"is".$name});
  267   }
  268   return 0;
  269 }
  270 
  271 #
  272 #  Check if a value is a number, complex, etc.
  273 #
  274 sub matchNumber   {my $n = shift; $n =~ m/^$$Value::context->{pattern}{signedNumber}$/i}
  275 sub matchInfinite {my $n = shift; $n =~ m/^$$Value::context->{pattern}{infinite}$/i}
  276 sub isReal    {classMatch(shift,'Real')}
  277 sub isComplex {classMatch(shift,'Complex')}
  278 sub isContext {class(shift) eq 'Context'}
  279 sub isFormula {classMatch(shift,'Formula')}
  280 sub isValue {
  281   my $v = shift;
  282   return (ref($v) || $v) =~ m/^Value::/ ||
  283          (ref($v) && ref($v) ne 'ARRAY' && ref($v) ne 'CODE' && $v->{isValue});
  284 }
  285 
  286 sub isNumber {
  287   my $n = shift;
  288   return $n->{tree}->isNumber if isFormula($n);
  289   return classMatch($n,'Real','Complex') || matchNumber($n);
  290 }
  291 
  292 sub isRealNumber {
  293   my $n = shift;
  294   return $n->{tree}->isRealNumber if isFormula($n);
  295   return isReal($n) || matchNumber($n);
  296 }
  297 
  298 sub isZero {
  299   my $self = shift;
  300   return 0 if scalar(@{$self->{data}}) == 0;
  301   foreach my $x (@{$self->{data}}) {return 0 if $x ne "0"}
  302   return 1;
  303 }
  304 
  305 sub isOne {0}
  306 
  307 sub isSetOfReals {0}
  308 sub canBeInUnion {
  309   my $self = shift;
  310   return $self->length == 2 && $self->typeRef->{entryType}{name} eq 'Number' &&
  311     $self->{open} =~ m/^[\(\[]?$/ && $self->{close} =~ m/^[\)\]]?$/;
  312 }
  313 
  314 ######################################################################
  315 
  316 #
  317 #  Value->Package(name[,noerror]])
  318 #
  319 #  Returns the package name for the specificied Value object class
  320 #  (as specified by the context's {value} hash, or "Value::name").
  321 #
  322 sub Package {(shift)->context->Package(@_)}
  323 
  324 =head3 makeValue
  325 
  326   Usage:  Value::makeValue(45);
  327 
  328   Will create a Real mathObject.
  329  #
  330  #  Convert non-Value objects to Values, if possible
  331  #
  332 
  333 =cut
  334 
  335 sub makeValue {
  336   my $x = shift; return $x if Value::isValue($x);
  337   my %params = (showError => 0, makeFormula => 1, context => Value->context, @_);
  338   my $context = $params{context};
  339   return $context->Package("Real")->make($context,$x) if matchNumber($x);
  340   if (matchInfinite($x)) {
  341     my $I = $context->Package("Infinity")->new($context);
  342     $I = $I->neg if $x =~ m/^$context->{pattern}{-infinity}$/;
  343     return $I;
  344   }
  345   return $context->Package("String")->make($context,$x)
  346     if !$Parser::installed || $context->{strings}{$x} ||
  347        ($x eq '' && $context->{flags}{allowEmptyStrings});
  348   return $x if !$params{makeFormula};
  349   Value::Error("String constant '%s' is not defined in this context",$x)
  350     if $params{showError};
  351   $x = $context->Package("Formula")->new($context,$x);
  352   $x = $x->eval if $x->isConstant;
  353   return $x;
  354 }
  355 
  356 =head3 showClass
  357 
  358   Usage:   TEXT( $mathObj -> showClass() );
  359 
  360     Will print the class of the MathObject
  361 
  362  #
  363  #  Get a printable version of the class of an object
  364  #  (used primarily in error messages)
  365  #
  366 
  367 =cut
  368 
  369 sub showClass {
  370   my $value = shift;
  371   if (ref($value) || $value !~ m/::/) {
  372     $value = Value::makeValue($value,makeFormula=>0);
  373     return "'".$value."'" unless Value::isValue($value);
  374   }
  375   my $class = class($value);
  376   return showType($value) if Value::classMatch($value,'List');
  377   $class .= ' Number' if Value::classMatch($value,'Real','Complex');
  378   $class .= ' of Intervals' if Value::classMatch($value,'Union');
  379   $class = 'Word' if Value::classMatch($value,'String');
  380   return 'a Formula that returns '.showType($value->{tree}) if Value::isFormula($value);
  381   return 'an '.$class if $class =~ m/^[aeio]/i;
  382   return 'a '.$class;
  383 }
  384 
  385 =head3 showType
  386 
  387   Usage:   TEXT( $mathObj -> showType() );
  388 
  389     Will print the class of the MathObject
  390 
  391  #
  392  #  Get a printable version of the type of an object
  393  #  (the class and type are not the same.  For example
  394  #  a Formula-class object can be of type Number)
  395  #
  396 
  397 =cut
  398 
  399 sub showType {
  400   my $value = shift;
  401   my $type = $value->type;
  402   if ($type eq 'List') {
  403     my $ltype = $value->typeRef->{entryType}{name};
  404     if ($ltype && $ltype ne 'unknown') {
  405       $ltype =~ s/y$/ie/;
  406       $type .= ' of '.$ltype.'s';
  407     }
  408   }
  409   return 'an Infinity' if $type eq 'String' && $value->{isInfinite};
  410   return 'a Word' if $type eq 'String';
  411   return 'a Complex Number' if $value->isComplex;
  412   return 'an '.$type if $type =~ m/^[aeio]/i;
  413   return 'a '.$type;
  414 }
  415 
  416 #
  417 #  Return a string describing a value's type
  418 #
  419 sub getType {
  420   my $equation = shift; my $value = shift;
  421   my $strings = $equation->{context}{strings};
  422   if (ref($value) eq 'ARRAY') {
  423     return 'Interval' if ($value->[0] =~ m/^[(\[]$/ && $value->[-1] =~ m/^[)\]]$/);
  424     my ($type,$ltype);
  425     foreach my $x (@{$value}) {
  426       $type = getType($equation,$x);
  427       if ($type eq 'value') {
  428         $type = $x->type if $x->classMatch('Formula');
  429         $type = 'Number' if $x->classMatch('Complex') || $type eq 'Complex';
  430       }
  431       $ltype = $type if $ltype eq '';
  432       return 'List' if $type ne $ltype;
  433     }
  434     return 'Point' if $ltype eq 'Number';
  435     return 'Matrix' if $ltype =~ m/Point|Matrix/;
  436     return 'List';
  437   }
  438   elsif (Value::isFormula($value)) {return 'Formula'}
  439   elsif (Value::classMatch($value,'Infinity')) {return 'Infinity'}
  440   elsif (Value::isReal($value)) {return 'Number'}
  441   elsif (Value::isValue($value)) {return 'value'}
  442   elsif (ref($value)) {return 'unknown'}
  443   elsif (defined($strings->{$value})) {return 'String'}
  444   elsif (Value::isNumber($value)) {return 'Number'}
  445   elsif ($value eq '' && $equation->{context}{flags}{allowEmptyStrings}) {return 'String'}
  446   return 'unknown';
  447 }
  448 
  449 #
  450 #  Get a string describing a value's type,
  451 #    and convert the value to a Value object (if needed)
  452 #
  453 sub getValueType {
  454   my $equation = shift; my $value = shift;
  455   my $type = Value::getType($equation,$value);
  456   if ($type eq 'String') {$type = $Value::Type{string}}
  457   elsif ($type eq 'Number') {$type = $Value::Type{number}}
  458   elsif ($type eq 'Infinity') {$type = $Value::Type{infinity}}
  459   elsif ($type eq 'value' || $type eq 'Formula') {$type = $value->typeRef}
  460   elsif ($type eq 'unknown') {
  461     $equation->Error(["Can't convert %s to a constant",Value::showClass($value)]);
  462   } else {
  463     $type = $equation->{context}->Package($type);
  464     $value = $type->new($equation->{context},@{$value});
  465     $type = $value->typeRef;
  466   }
  467   return ($value,$type);
  468 }
  469 
  470 #
  471 #  Convert a list of values to a list of formulas (called by Parser::Value)
  472 #
  473 sub toFormula {
  474   my $formula = shift;
  475   my $processed = 0;
  476   my @f = (); my $vars = {};
  477   foreach my $x (@_) {
  478     if (isFormula($x)) {
  479       $formula->{context} = $x->{context}, $processed = 1 unless $processed;
  480       $formula->{variables} = {%{$formula->{variables}},%{$x->{variables}}};
  481       push(@f,$x->{tree}->copy($formula));
  482     } else {
  483       push(@f,$formula->Item("Value")->new($formula,$x));
  484     }
  485   }
  486   return (@f);
  487 }
  488 
  489 #
  490 #  Convert a list of values (and open and close parens)
  491 #    to a formula whose type is the list type associated with
  492 #    the parens.
  493 #
  494 sub formula {
  495   my $self = shift; my $values = shift;
  496   my $context = $self->context;
  497   my $list = $context->lists->get($self->class);
  498   my $open = $list->{'open'};
  499   my $close = $list->{'close'};
  500   my $paren = $open; $paren = 'list' if $self->classMatch('List');
  501   my $formula = $self->Package("Formula")->blank($context);
  502   my @coords = Value::toFormula($formula,@{$values});
  503   $formula->{tree} = $formula->Item("List")->new($formula,[@coords],0,
  504      $formula->{context}{parens}{$paren},$coords[0]->typeRef,$open,$close);
  505   $formula->{autoFormula} = 1;  # mark that this was generated automatically
  506   return $formula;
  507 }
  508 
  509 #
  510 #  A shortcut for new() that creates an instance of the object,
  511 #    but doesn't do the error checking.  We assume the data are already
  512 #    known to be good.
  513 #
  514 sub make {
  515   my $self = shift; my $class = ref($self) || $self;
  516   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  517   bless {data => [@_], context => $context}, $class;
  518 }
  519 
  520 #
  521 #  Easy method for setting parameters of an object
  522 #  (returns a copy with the new values set, but the copy
  523 #  is not a deep copy.)
  524 #
  525 sub with {
  526   my $self = shift;
  527   bless {%{$self},@_}, ref($self);
  528 }
  529 
  530 ######################################################################
  531 
  532 #
  533 #  Return a type structure for the item
  534 #    (includes name, length of vectors, and so on)
  535 #
  536 sub Type {
  537   my $name = shift; my $length = shift; my $entryType = shift;
  538   $length = 1 unless defined $length;
  539   return {name => $name, length => $length, entryType => $entryType,
  540           list => (defined $entryType), @_};
  541 }
  542 
  543 #
  544 #  Some predefined types
  545 #
  546 %Type = (
  547   number   => Value::Type('Number',1),
  548   complex  => Value::Type('Number',2),
  549   string   => Value::Type('String',1),
  550   infinity => Value::Type('Infinity',1),
  551   unknown  => Value::Type('unknown',0,undef,list => 1)
  552 );
  553 
  554 #
  555 #  Return various information about the object
  556 #
  557 sub value {return @{(shift)->{data}}}                  # the value of the object (as an array)
  558 sub data {return (shift)->{data}}                      # the reference to the value
  559 sub length {return scalar(@{(shift)->{data}})}         # the number of coordinates
  560 sub type {return (shift)->typeRef->{name}}             # the object type
  561 sub entryType {return (shift)->typeRef->{entryType}}   # the coordinate type
  562 #
  563 #  The the full type-hash for the item
  564 #
  565 sub typeRef {
  566   my $self = shift;
  567   return Value::Type($self->class, $self->length, $Value::Type{number});
  568 }
  569 #
  570 #  The Value.pm object class
  571 #
  572 sub class {
  573   my $self = shift; my $class = ref($self) || $self;
  574   $class =~ s/.*:://;
  575   return $class;
  576 }
  577 
  578 #
  579 #  Get an element from a point, vector, matrix, or list
  580 #
  581 sub extract {
  582   my $M = shift; my $i; my @indices = @_;
  583   return unless Value::isValue($M);
  584   @indices = $_[0]->value if scalar(@_) == 1 && Value::isValue($_[0]);
  585   while (scalar(@indices) > 0) {
  586     return if Value::isNumber($M);
  587     $i = shift @indices; $i = $i->value if Value::isValue($i);
  588     Value::Error("Can't extract element number '%s' (index must be an integer)",$i)
  589       unless $i =~ m/^-?\d+$/;
  590     return if $i == 0; $i-- if $i > 0;
  591     $M = $M->data->[$i];
  592   }
  593   return $M;
  594 }
  595 
  596 ######################################################################
  597 
  598 use overload
  599        '+'   => '_add',
  600        '-'   => '_sub',
  601        '*'   => '_mult',
  602        '/'   => '_div',
  603        '**'  => '_power',
  604        '.'   => '_dot',
  605        'x'   => '_cross',
  606        '%'   => '_modulo',
  607        '<=>' => '_compare',
  608        'cmp' => '_compare_string',
  609        '~'   => '_twiddle',
  610        'neg' => '_neg',
  611        'abs' => '_abs',
  612        'sqrt'=> '_sqrt',
  613        'exp' => '_exp',
  614        'log' => '_log',
  615        'sin' => '_sin',
  616        'cos' => '_cos',
  617      'atan2' => '_atan2',
  618   'nomethod' => 'nomethod',
  619         '""' => 'stringify';
  620 
  621 #
  622 #  Promote an operand to the same precedence as the current object
  623 #
  624 sub promotePrecedence {
  625   my $self = shift; my $other = shift; my $context = $self->context;
  626   return 0 unless Value::isValue($other);
  627   my $sprec = $context->{precedence}{class($self)};
  628   my $oprec = $context->{precedence}{class($other)};
  629   return (defined($sprec) && defined($oprec) && $sprec < $oprec);
  630 }
  631 
  632 sub promote {
  633   my $self = shift;
  634   return $_[0] if scalar(@_) == 1 && ref($_[1]) eq ref($self);
  635   return $self->new(@_);
  636 }
  637 
  638 #
  639 #  Return the operators in the correct order
  640 #
  641 sub checkOpOrder {
  642   my ($l,$r,$flag) = @_;
  643   if ($flag) {return ($l,$r,$l)} else {return ($l,$l,$r)}
  644 }
  645 
  646 #
  647 #  Return the operators in the correct order, and promote the
  648 #  other value, if needed.
  649 #
  650 sub checkOpOrderWithPromote {
  651   my ($l,$r,$flag) = @_; $r = $l->promote($r);
  652   if ($flag) {return ($l,$r,$l)} else {return ($l,$l,$r)}
  653 }
  654 
  655 #
  656 #  Handle a binary operator, promoting the object types
  657 #  as needed, and then calling the main method
  658 #
  659 sub binOp {
  660   my ($l,$r,$flag,$call) = @_;
  661   if ($l->promotePrecedence($r)) {return $r->$call($l,!$flag)}
  662                             else {return $l->$call($r,$flag)}
  663 }
  664 
  665 #
  666 #  stubs for binary operations (with promotion)
  667 #
  668 sub _add            {binOp(@_,'add')}
  669 sub _sub            {binOp(@_,'sub')}
  670 sub _mult           {binOp(@_,'mult')}
  671 sub _div            {binOp(@_,'div')}
  672 sub _power          {binOp(@_,'power')}
  673 sub _cross          {binOp(@_,'cross')}
  674 sub _modulo         {binOp(@_,'modulo')}
  675 
  676 sub _compare        {transferTolerances(@_); binOp(@_,'compare')}
  677 sub _compare_string {binOp(@_,'compare_string')}
  678 
  679 sub _atan2          {binOp(@_,'atan2')}
  680 
  681 sub _twiddle        {(shift)->twiddle}
  682 sub _neg            {(shift)->neg}
  683 sub _abs            {(shift)->abs}
  684 sub _sqrt           {(shift)->sqrt}
  685 sub _exp            {(shift)->exp}
  686 sub _log            {(shift)->log}
  687 sub _sin            {(shift)->sin}
  688 sub _cos            {(shift)->cos}
  689 
  690 #
  691 #  Default stub to call when no function is defined for an operation
  692 #
  693 sub nomethod {
  694   my ($l,$r,$flag,$op) = @_;
  695   my $call = $l->context->{method}{$op};
  696   if (defined($call) && $l->promotePrecedence($r)) {return $r->$call($l,!$flag)}
  697   my $error = "Can't use '%s' with %s-valued operands";
  698   $error .= " (use '**' for exponentiation)" if $op eq '^';
  699   Value::Error($error,$op,$l->class);
  700 }
  701 
  702 sub nodef {
  703   my $self = shift; my $func = shift;
  704   Value::Error("Can't use '%s' with %s-valued operands",$func,$self->class);
  705 }
  706 
  707 #
  708 #  Stubs for the sub-classes
  709 #
  710 sub add    {nomethod(@_,'+')}
  711 sub sub    {nomethod(@_,'-')}
  712 sub mult   {nomethod(@_,'*')}
  713 sub div    {nomethod(@_,'/')}
  714 sub power  {nomethod(@_,'**')}
  715 sub cross  {nomethod(@_,'x')}
  716 sub modulo {nomethod(@_,'%')}
  717 
  718 sub twiddle {nodef(shift,"~")}
  719 sub neg     {nodef(shift,"-")}
  720 sub abs     {nodef(shift,"abs")}
  721 sub sqrt    {nodef(shift,"sqrt")}
  722 sub exp     {nodef(shift,"exp")}
  723 sub log     {nodef(shift,"log")}
  724 sub sin     {nodef(shift,"sin")}
  725 sub cos     {nodef(shift,"cos")}
  726 
  727 #
  728 #  If the right operand is higher precedence, we switch the order.
  729 #
  730 #  If the right operand is also a Value object, we do the object's
  731 #  dot method to combine the two objects of the same class.
  732 #
  733 #  Otherwise, since . is used for string concatenation, we want to retain
  734 #  that.  Since the resulting string is often used in Formula and will be
  735 #  parsed again, we put parentheses around the values to guarantee that
  736 #  the values will be treated as one mathematical unit.  For example, if
  737 #  $f = Formula("1+x") and $g = Formula("y") then Formula("$f/$g") will be
  738 #  (1+x)/y not 1+(x/y), as it would be without the implicit parentheses.
  739 #
  740 sub _dot {
  741   my ($l,$r,$flag) = @_;
  742   return $r->_dot($l,!$flag) if ($l->promotePrecedence($r));
  743   return $l->dot($r,$flag) if (Value::isValue($r));
  744   if (Value->context->flag('StringifyAsTeX')) {$l = $l->TeX} else {$l = $l->pdot}
  745   return ($flag)? ($r.$l): ($l.$r);
  746 }
  747 #
  748 #  Some classes override this
  749 #
  750 sub dot {
  751   my ($l,$r,$flag) = @_;
  752   my $tex = Value->context->flag('StringifyAsTeX');
  753   if ($tex) {$l = $l->TeX} else {$l = $l->pdot}
  754   if (ref($r)) {if ($tex) {$r = $r->TeX} else {$r = $r->pdot}}
  755   return ($flag)? ($r.$l): ($l.$r);
  756 }
  757 
  758 #
  759 #  Some classes override this to add parens
  760 #
  761 sub pdot {shift->stringify}
  762 
  763 
  764 #
  765 #  Compare the values of the objects
  766 #    (list classes should replace this)
  767 #
  768 sub compare {
  769   my ($l,$r) = Value::checkOpOrder(@_);
  770   return $l->value <=> $r->value;
  771 }
  772 
  773 #
  774 #  Compare the values as strings
  775 #
  776 sub compare_string {
  777   my ($l,$r,$flag) = @_;
  778   $l = $l->stringify; $r = $r->stringify if Value::isValue($r);
  779   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  780   return $l cmp $r;
  781 }
  782 
  783 #
  784 #  Copy flags from the parent object to its children (recursively).
  785 #
  786 sub transferFlags {
  787   my $self = shift;
  788   foreach my $flag (@_) {
  789     next unless defined $self->{$flag};
  790     foreach my $x (@{$self->{data}}) {
  791       if ($x->{$flag} ne $self->{$flag}) {
  792   $x->{$flag} = $self->{$flag};
  793   $x->transferFlags($flag);
  794       }
  795     }
  796   }
  797 }
  798 
  799 sub transferTolerances {
  800   my ($self,$other) = @_;
  801   $self->transferFlags("tolerance","tolType","zeroLevel","zeroLevelTol");
  802   $other->transferFlags("tolerance","tolType","zeroLevel","zeroLevelTol") if Value::isValue($other);
  803 }
  804 
  805 =head3 output methods for MathObjects
  806 
  807  #
  808  #  Generate the various output formats
  809  #  (can be replaced by sub-classes)
  810  #
  811 
  812 =cut
  813 
  814 =head4 stringify
  815 
  816   Usage:   TEXT($mathObj); or TEXT( $mathObj->stringify() ) ;
  817 
  818     Produces text string or TeX output depending on context
  819       Context()->texStrings;
  820       Context()->normalStrings;
  821 
  822     called automatically when object is called in a string context.
  823 
  824 =cut
  825 
  826 sub stringify {
  827   my $self = shift;
  828   return $self->TeX if Value->context->flag('StringifyAsTeX');
  829   return $self->string;
  830 }
  831 
  832 =head4 ->string
  833 
  834   Usage: $mathObj->string()
  835 
  836   ---produce a string representation of the object
  837            (as opposed to stringify, which can produce TeX or string versions)
  838 
  839 =cut
  840 
  841 sub string {
  842   my $self = shift; my $equation = shift;
  843   my $def = ($equation->{context} || $self->context)->lists->get($self->class);
  844   return $self->value unless $def;
  845   my $open = shift; my $close = shift;
  846   $open  = $self->{open}  unless defined($open);
  847   $open  = $def->{open}   unless defined($open);
  848   $close = $self->{close} unless defined($close);
  849   $close = $def->{close}  unless defined($close);
  850   my @coords = ();
  851   foreach my $x (@{$self->data}) {
  852     if (Value::isValue($x)) {
  853       $x->{format} = $self->{format} if defined $self->{format};
  854       push(@coords,$x->string($equation));
  855     } else {
  856       push(@coords,$x);
  857     }
  858   }
  859   return $open.join($def->{separator},@coords).$close;
  860 }
  861 
  862 =head4 ->TeX
  863 
  864   Usage: $mathObj->TeX()
  865 
  866   ---produce TeX prepresentation of the object
  867 
  868 =cut
  869 
  870 sub TeX {
  871   my $self = shift; my $equation = shift;
  872   my $context = $equation->{context} || $self->context;
  873   my $def = $context->lists->get($self->class);
  874   return $self->string(@_) unless $def;
  875   my $open = shift; my $close = shift;
  876   $open  = $self->{open}  unless defined($open);
  877   $open  = $def->{open}   unless defined($open);
  878   $close = $self->{close} unless defined($close);
  879   $close = $def->{close}  unless defined($close);
  880   $open =~ s/([{}])/\\$1/g; $close =~ s/([{}])/\\$1/g;
  881   $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  882   my @coords = (); my $str = $context->{strings};
  883   foreach my $x (@{$self->data}) {
  884     if (Value::isValue($x)) {
  885       $x->{format} = $self->{format} if defined $self->{format};
  886       push(@coords,$x->TeX($equation));
  887     } elsif (defined($str->{$x}) && $str->{$x}{TeX}) {push(@coords,$str->{$x}{TeX})}
  888     else {push(@coords,$x)}
  889   }
  890   return $open.join(',',@coords).$close;
  891 }
  892 
  893 #
  894 #  For perl, call the appropriate constructor around the object's data
  895 #
  896 sub perl {
  897   my $self = shift; my $parens = shift; my $matrix = shift;
  898   my $mtype = $self->classMatch('Matrix'); $mtype = -1 if $mtype & !$matrix;
  899   my $perl; my @p = ();
  900   foreach my $x (@{$self->data}) {
  901     if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)}
  902   }
  903   @p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $self->classMatch('Interval');
  904   if ($matrix) {
  905     $perl = join(',',@p);
  906     $perl = '['.$perl.']' if $mtype > 0;
  907   } else {
  908     $perl = ref($self).'->new('.join(',',@p).')';
  909     $perl = "($perl)->with(open=>'$self->{open}',close=>'$self->{close}')"
  910       if $self->classMatch('List') && $self->{open}.$self->{close} ne '()';
  911     $perl = '('.$perl.')' if $parens == 1;
  912   }
  913   return $perl;
  914 }
  915 
  916 #
  917 #  Stubs for when called by Parser
  918 #
  919 sub eval {shift}
  920 sub reduce {shift}
  921 
  922 sub ijk {
  923   Value::Error("Can't use method 'ijk' with objects of type '%s'",(shift)->class);
  924 }
  925 
  926 
  927 =head3 Error
  928 
  929   Usage: $mathObj->Error("We're sorry...");
  930 
  931  #
  932  #  Report an error
  933  #
  934 
  935 =cut
  936 
  937 sub Error {
  938   my $message = shift; my $context = Value->context;
  939   $message = [$message,@_] if scalar(@_) > 0;
  940   $context->setError($message,'');
  941   $message = $context->{error}{message};
  942   die $message . traceback() if $context->flags('showTraceback');
  943   die $message . getCaller();
  944 }
  945 
  946 #
  947 #  Try to locate the line and file where the error occurred
  948 #
  949 sub getCaller {
  950   my $frame = 2;
  951   while (my ($pkg,$file,$line,$subname) = caller($frame++)) {
  952     return " at line $line of $file\n"
  953       unless $pkg =~ /^(Value|Parser)/ ||
  954              $subname =~ m/^(Value|Parser).*(new|call)$/;
  955   }
  956   return "";
  957 }
  958 
  959 #
  960 #  For debugging
  961 #
  962 sub traceback {
  963   my $frame = shift; $frame = 2 unless defined($frame);
  964   my $trace = '';
  965   while (my ($pkg,$file,$line,$subname) = caller($frame++))
  966     {$trace .= " in $subname at line $line of $file\n"}
  967   return $trace;
  968 }
  969 
  970 ###########################################################################
  971 #
  972 #  Load the sub-classes.
  973 #
  974 
  975 END {
  976   use Value::Real;
  977   use Value::Complex;
  978   use Value::Infinity;
  979   use Value::Point;
  980   use Value::Vector;
  981   use Value::Matrix;
  982   use Value::List;
  983   use Value::Interval;
  984   use Value::Set;
  985   use Value::Union;
  986   use Value::String;
  987   use Value::Formula;
  988 
  989   use Value::WeBWorK;  # stuff specific to WeBWorK
  990 }
  991 
  992 ###########################################################################
  993 
  994 our $installed = 1;
  995 
  996 ###########################################################################
  997 
  998 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9