[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 4987 - (download) (as text) (annotate)
Thu Jun 7 21:54:46 2007 UTC (12 years, 7 months ago) by dpvc
File size: 26039 byte(s)
Added Value->Package(name[,context]) to look up what package is
currently set to handle the named type.  E.g.,
Value->Package("Complex") usually returns "Value::Complex".  These can
be overridden in the Context so that modified vesions of the
MathObjects can be made to replace the existing ones more easily.  In
particular, the Parser classes should call these (not yet implemented)
when they create objects, so that you can override the object they
create.

Also cleaned up some more context issues (with still more to come).

    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   return $self->{$name} if ref($self) && ref($self) ne 'ARRAY' && defined($self->{$name});
  222   my $context = $self->context;
  223   return $context->{answerHash}{$name}
  224     if defined($context->{answerHash}) && defined($context->{answerHash}{$name});  # use WW answerHash flags first
  225   return $context->{flags}{$name} if defined($context->{flags}{$name});
  226   return shift;
  227 }
  228 
  229 #
  230 #  Get or set the context of an object
  231 #
  232 sub context {
  233   my $self = shift; my $context = shift;
  234   if (ref($self) && ref($self) ne 'ARRAY') {
  235     if ($context && $self->{context} ne $context) {
  236       $self->{context} = $context;
  237       if (defined $self->{data}) {
  238         foreach my $x (@{$self->{data}}) {$x->context($context) if ref($x)}
  239       }
  240     }
  241     return $self->{context} if $self->{context};
  242   }
  243   return $$Value::context;
  244 }
  245 
  246 #
  247 #  Set context but return object
  248 #
  249 sub inContext {my $self = shift; $self->context(@_); $self}
  250 
  251 
  252 #############################################################
  253 
  254 #
  255 #  Check if a value is a number, complex, etc.
  256 #
  257 sub matchNumber   {my $n = shift; $n =~ m/^$$context->{pattern}{signedNumber}$/i}
  258 sub matchInfinite {my $n = shift; $n =~ m/^$$context->{pattern}{infinite}$/i}
  259 sub isReal    {class(shift) eq 'Real'}
  260 sub isComplex {class(shift) eq 'Complex'}
  261 sub isFormula {
  262   my $v = shift;
  263   return class($v) eq 'Formula' ||
  264          (ref($v) && ref($v) ne 'ARRAY' && $v->{isFormula});
  265 }
  266 sub isValue {
  267   my $v = shift;
  268   return (ref($v) || $v) =~ m/^Value::/ ||
  269          (ref($v) && ref($v) ne 'ARRAY' && ref($v) ne 'CODE' && $v->{isValue});
  270 }
  271 
  272 sub isNumber {
  273   my $n = shift;
  274   return $n->{tree}->isNumber if isFormula($n);
  275   return isReal($n) || isComplex($n) || matchNumber($n);
  276 }
  277 
  278 sub isRealNumber {
  279   my $n = shift;
  280   return $n->{tree}->isRealNumber if isFormula($n);
  281   return isReal($n) || matchNumber($n);
  282 }
  283 
  284 sub isZero {
  285   my $self = shift;
  286   return 0 if scalar(@{$self->{data}}) == 0;
  287   foreach my $x (@{$self->{data}}) {return 0 if $x ne "0"}
  288   return 1;
  289 }
  290 
  291 sub isOne {0}
  292 
  293 sub isSetOfReals {0}
  294 sub canBeInUnion {
  295   my $self = shift;
  296   return $self->length == 2 && $self->typeRef->{entryType}{name} eq 'Number' &&
  297     $self->{open} =~ m/^[\(\[]$/ && $self->{close} =~ m/^[\)\]]$/;
  298 }
  299 
  300 ######################################################################
  301 
  302 #
  303 #  Value->Package(name[,context])
  304 #
  305 #  Returns the package name for the specificied Value object class
  306 #  (as specified by the context's {value} hash, or "Value::name").
  307 #
  308 sub Package {
  309   my $self = shift; my $class = shift; my $context = $self->context;
  310   return $context->{value}{$class} if defined $context->{value}{$class};
  311   return "Value::$class" if defined @{"Value::${class}::ISA"};
  312   Value::Error("No such package 'Value::%s'",$class);
  313 }
  314 
  315 =head3 makeValue
  316 
  317   Usage:  Value::makeValue(45);
  318 
  319   Will create a Real mathObject.
  320  #
  321  #  Convert non-Value objects to Values, if possible
  322  #
  323 
  324 =cut
  325 
  326 sub makeValue {
  327   my $x = shift;
  328   my %params = (showError => 0, makeFormula => 1, context => $$Value::context, @_);
  329   my $context = $params{context};
  330   return $x if ref($x) && ref($x) ne 'ARRAY';
  331   return Value->Package("Real",$context)->make($x)->inContext($context) if matchNumber($x);
  332   if (matchInfinite($x)) {
  333     my $I = Value->Package("Infinity",$context)->new()->inContext($context);
  334     $I = $I->neg if $x =~ m/^$context->{pattern}{-infinity}$/;
  335     return $I;
  336   }
  337   return Value->Package("String",$context)->make($x)->inContext($context)
  338     if !$Parser::installed || $context->{strings}{$x} ||
  339        ($x eq '' && $context->{flags}{allowEmptyStrings});
  340   return $x if !$params{makeFormula};
  341   Value::Error("String constant '%s' is not defined in this context",$x)
  342     if $params{showError};
  343   $x = Value->Package("Formula",$context)->new($x)->inContext($context);
  344   $x = $x->eval if $x->isConstant;
  345   return $x;
  346 }
  347 
  348 =head3 showClass
  349 
  350   Usage:   TEXT( $mathObj -> showClass() );
  351 
  352     Will print the class of the MathObject
  353 
  354  #
  355  #  Get a printable version of the class of an object
  356  #  (used primarily in error messages)
  357  #
  358 
  359 =cut
  360 
  361 sub showClass {
  362   my $value = shift;
  363   if (ref($value) || $value !~ m/::/) {
  364     $value = makeValue($value,makeFormula=>0);
  365     return "'".$value."'" unless Value::isValue($value);
  366   }
  367   my $class = class($value);
  368   return showType($value) if ($class eq 'List');
  369   $class .= ' Number' if $class =~ m/^(Real|Complex)$/;
  370   $class .= ' of Intervals' if $class eq 'Union';
  371   $class = 'Word' if $class eq 'String';
  372   return 'a Formula that returns '.showType($value->{tree}) if ($class eq 'Formula');
  373   return 'an '.$class if $class =~ m/^[aeio]/i;
  374   return 'a '.$class;
  375 }
  376 
  377 =head3 showType
  378 
  379   Usage:   TEXT( $mathObj -> showType() );
  380 
  381     Will print the class of the MathObject
  382 
  383  #
  384  #  Get a printable version of the type of an object
  385  #  (the class and type are not the same.  For example
  386  #  a Formula-class object can be of type Number)
  387  #
  388 
  389 =cut
  390 
  391 sub showType {
  392   my $value = shift;
  393   my $type = $value->type;
  394   if ($type eq 'List') {
  395     my $ltype = $value->typeRef->{entryType}{name};
  396     if ($ltype && $ltype ne 'unknown') {
  397       $ltype =~ s/y$/ie/;
  398       $type .= ' of '.$ltype.'s';
  399     }
  400   }
  401   return 'an Infinity' if $type eq 'String' && $value->{isInfinite};
  402   return 'a Word' if $type eq 'String';
  403   return 'a Complex Number' if $value->isComplex;
  404   return 'an '.$type if $type =~ m/^[aeio]/i;
  405   return 'a '.$type;
  406 }
  407 
  408 #
  409 #  Return a string describing a value's type
  410 #
  411 sub getType {
  412   my $equation = shift; my $value = shift;
  413   my $strings = $equation->{context}{strings};
  414   if (ref($value) eq 'ARRAY') {
  415     return 'Interval' if ($value->[0] =~ m/^[(\[]$/ && $value->[-1] =~ m/^[)\]]$/);
  416     my ($type,$ltype);
  417     foreach my $x (@{$value}) {
  418       $type = getType($equation,$x);
  419       if ($type eq 'value') {
  420         $type = $x->type if $x->class eq 'Formula';
  421         $type = 'Number' if $x->class eq 'Complex' || $type eq 'Complex';
  422       }
  423       $ltype = $type if $ltype eq '';
  424       return 'List' if $type ne $ltype;
  425     }
  426     return 'Point' if $ltype eq 'Number';
  427     return 'Matrix' if $ltype =~ m/Point|Matrix/;
  428     return 'List';
  429   }
  430   elsif (Value::isFormula($value)) {return 'Formula'}
  431   elsif (Value::class($value) eq 'Infinity') {return 'Infinity'}
  432   elsif (Value::isReal($value)) {return 'Number'}
  433   elsif (Value::isValue($value)) {return 'value'}
  434   elsif (ref($value)) {return 'unknown'}
  435   elsif (defined($strings->{$value})) {return 'String'}
  436   elsif (Value::isNumber($value)) {return 'Number'}
  437   elsif ($value eq '' && $equation->{context}{flags}{allowEmptyStrings}) {return 'String'}
  438   return 'unknown';
  439 }
  440 
  441 #
  442 #  Get a string describing a value's type,
  443 #    and convert the value to a Value object (if needed)
  444 #
  445 sub getValueType {
  446   my $equation = shift; my $value = shift;
  447   my $type = Value::getType($equation,$value);
  448   if ($type eq 'String') {$type = $Value::Type{string}}
  449   elsif ($type eq 'Number') {$type = $Value::Type{number}}
  450   elsif ($type eq 'Infinity') {$type = $Value::Type{infinity}}
  451   elsif ($type eq 'value' || $type eq 'Formula') {$type = $value->typeRef}
  452   elsif ($type eq 'unknown') {
  453     $equation->Error(["Can't convert %s to a constant",Value::showClass($value)]);
  454   } else {
  455     $type = Value->Package($type,$equation->{context});
  456     $value = $type->new(@{$value})->inContext($equation->{context});
  457     $type = $value->typeRef;
  458   }
  459   return ($value,$type);
  460 }
  461 
  462 #
  463 #  Convert a list of values to a list of formulas (called by Parser::Value)
  464 #
  465 sub toFormula {
  466   my $formula = shift;
  467   my $processed = 0;
  468   my @f = (); my $vars = {};
  469   foreach my $x (@_) {
  470     if (isFormula($x)) {
  471       $formula->{context} = $x->{context}, $processed = 1 unless $processed;
  472       $formula->{variables} = {%{$formula->{variables}},%{$x->{variables}}};
  473       push(@f,$x->{tree}->copy($formula));
  474     } else {
  475       push(@f,$formula->{context}{parser}{Value}->new($formula,$x));
  476     }
  477   }
  478   return (@f);
  479 }
  480 
  481 #
  482 #  Convert a list of values (and open and close parens)
  483 #    to a formula whose type is the list type associated with
  484 #    the parens.
  485 #
  486 sub formula {
  487   my $self = shift; my $values = shift;
  488   my $class = $self->class;
  489   my $list = $$context->lists->get($class);
  490   my $open = $list->{'open'};
  491   my $close = $list->{'close'};
  492   my $paren = $open; $paren = 'list' if $class eq 'List';
  493   my $formula = $self->Package("Formula")->blank($self->context);
  494   my @coords = Value::toFormula($formula,@{$values});
  495   $formula->{tree} = $formula->{context}{parser}{List}->new($formula,[@coords],0,
  496      $formula->{context}{parens}{$paren},$coords[0]->typeRef,$open,$close);
  497   $formula->{autoFormula} = 1;  # mark that this was generated automatically
  498   return $formula;
  499 }
  500 
  501 #
  502 #  A shortcut for new() that creates an instance of the object,
  503 #    but doesn't do the error checking.  We assume the data are already
  504 #    known to be good.
  505 #
  506 sub make {
  507   my $self = shift; my $class = ref($self) || $self;
  508   bless {data => [@_], context => $self->context}, $class;
  509 }
  510 
  511 #
  512 #  Easy method for setting parameters of an object
  513 #
  514 sub with {
  515   my $self = shift; my %hash = @_;
  516   foreach my $id (keys(%hash)) {$self->{$id} = $hash{$id}}
  517   return $self;
  518 }
  519 
  520 ######################################################################
  521 
  522 #
  523 #  Return a type structure for the item
  524 #    (includes name, length of vectors, and so on)
  525 #
  526 sub Type {
  527   my $name = shift; my $length = shift; my $entryType = shift;
  528   $length = 1 unless defined $length;
  529   return {name => $name, length => $length, entryType => $entryType,
  530           list => (defined $entryType), @_};
  531 }
  532 
  533 #
  534 #  Some predefined types
  535 #
  536 %Type = (
  537   number   => Value::Type('Number',1),
  538   complex  => Value::Type('Number',2),
  539   string   => Value::Type('String',1),
  540   infinity => Value::Type('Infinity',1),
  541   unknown  => Value::Type('unknown',0,undef,list => 1)
  542 );
  543 
  544 #
  545 #  Return various information about the object
  546 #
  547 sub value {return @{(shift)->{data}}}                  # the value of the object (as an array)
  548 sub data {return (shift)->{data}}                      # the reference to the value
  549 sub length {return scalar(@{(shift)->{data}})}         # the number of coordinates
  550 sub type {return (shift)->typeRef->{name}}             # the object type
  551 sub entryType {return (shift)->typeRef->{entryType}}   # the coordinate type
  552 #
  553 #  The the full type-hash for the item
  554 #
  555 sub typeRef {
  556   my $self = shift;
  557   return Value::Type($self->class, $self->length, $Value::Type{number});
  558 }
  559 #
  560 #  The Value.pm object class
  561 #
  562 sub class {
  563   my $self = shift; my $class = ref($self) || $self;
  564   $class =~ s/.*:://;
  565   return $class;
  566 }
  567 
  568 #
  569 #  Get an element from a point, vector, matrix, or list
  570 #
  571 sub extract {
  572   my $M = shift; my $i; my @indices = @_;
  573   return unless Value::isValue($M);
  574   @indices = $_[0]->value if scalar(@_) == 1 && Value::isValue($_[0]);
  575   while (scalar(@indices) > 0) {
  576     $i = shift @indices; $i-- if $i > 0; $i = $i->value if Value::isValue($i);
  577     Value::Error("Can't extract element number '%s' (index must be an integer)",$i)
  578       unless $i =~ m/^-?\d+$/;
  579     $M = $M->data->[$i];
  580   }
  581   return $M;
  582 }
  583 
  584 ######################################################################
  585 
  586 use overload
  587        '+'   => '_add',
  588        '-'   => '_sub',
  589        '*'   => '_mult',
  590        '/'   => '_div',
  591        '**'  => '_power',
  592        '.'   => '_dot',
  593        'x'   => '_cross',
  594        '%'   => '_modulo',
  595        '<=>' => '_compare',
  596        'cmp' => '_compare_string',
  597        '~'   => '_twiddle',
  598        'neg' => '_neg',
  599        'abs' => '_abs',
  600        'sqrt'=> '_sqrt',
  601        'exp' => '_exp',
  602        'log' => '_log',
  603        'sin' => '_sin',
  604        'cos' => '_cos',
  605      'atan2' => '_atan2',
  606   'nomethod' => 'nomethod',
  607         '""' => 'stringify';
  608 
  609 #
  610 #  Promote an operand to the same precedence as the current object
  611 #
  612 sub promotePrecedence {
  613   my $self = shift; my $other = shift;
  614   return 0 unless Value::isValue($other);
  615   my $sprec = $$context->{precedence}{class($self)};
  616   my $oprec = $$context->{precedence}{class($other)};
  617   return (defined($sprec) && defined($oprec) && $sprec < $oprec);
  618 }
  619 
  620 sub promote {
  621   my $self = shift;
  622   return $self->new(shift);
  623 }
  624 
  625 sub checkOpOrder {
  626   my ($l,$r,$flag) = @_;
  627   if ($flag) {return ($l,$r,$l)} else {return ($l,$l,$r)}
  628 }
  629 
  630 #
  631 #  Handle a binary operator, promoting the object types
  632 #  as needed, and then calling the main method
  633 #
  634 sub binOpPromote {
  635   my ($l,$r,$flag,$call) = @_;
  636   if ($l->promotePrecedence($r)) {return $r->$call($r->promote($l),!$flag)}
  637                             else {return $l->$call($l->promote($r),$flag)}
  638 }
  639 sub binOp {
  640   my ($l,$r,$flag,$call) = @_;
  641   if ($l->promotePrecedence($r)) {return $r->$call($l,!$flag)}
  642                             else {return $l->$call($r,$flag)}
  643 }
  644 
  645 #
  646 #  stubs for binary operations (with promotion)
  647 #
  648 sub _add    {binOpPromote(@_,'add')}
  649 sub _sub    {binOpPromote(@_,'sub')}
  650 sub _mult   {binOpPromote(@_,'mult')}
  651 sub _div    {binOpPromote(@_,'div')}
  652 sub _power  {binOpPromote(@_,'power')}
  653 sub _cross  {binOpPromote(@_,'cross')}
  654 sub _modulo {binOpPromote(@_,'modulo')}
  655 
  656 sub _compare        {binOpPromote(@_,'compare')}
  657 sub _compare_string {binOp(@_,'compare_string')}
  658 
  659 sub _atan2  {binOp(@_,'atan2')}
  660 
  661 sub _twiddle {(shift)->twiddle}
  662 sub _neg     {(shift)->neg}
  663 sub _abs     {(shift)->abs}
  664 sub _sqrt    {(shift)->sqrt}
  665 sub _exp     {(shift)->exp}
  666 sub _log     {(shift)->log}
  667 sub _sin     {(shift)->sin}
  668 sub _cos     {(shift)->cos}
  669 
  670 #
  671 #  Default stub to call when no function is defined for an operation
  672 #
  673 sub nomethod {
  674   my ($l,$r,$flag,$op) = @_;
  675   my $call = $$context->{method}{$op};
  676   if (defined($call) && $l->promotePrecedence($r)) {return $r->$call($l,!$flag)}
  677   my $error = "Can't use '%s' with %s-valued operands";
  678   $error .= " (use '**' for exponentiation)" if $op eq '^';
  679   Value::Error($error,$op,$l->class);
  680 }
  681 
  682 sub nodef {
  683   my $self = shift; my $func = shift;
  684   Value::Error("Can't use '%s' with %s-valued operands",$func,$self->class);
  685 }
  686 
  687 #
  688 #  Stubs for the sub-classes
  689 #
  690 sub add    {nomethod(@_,'+')}
  691 sub sub    {nomethod(@_,'-')}
  692 sub mult   {nomethod(@_,'*')}
  693 sub div    {nomethod(@_,'/')}
  694 sub power  {nomethod(@_,'**')}
  695 sub cross  {nomethod(@_,'x')}
  696 sub modulo {nomethod(@_,'%')}
  697 
  698 sub twiddle {nodef(shift,"~")}
  699 sub neg     {nodef(shift,"-")}
  700 sub abs     {nodef(shift,"abs")}
  701 sub sqrt    {nodef(shift,"sqrt")}
  702 sub exp     {nodef(shift,"exp")}
  703 sub log     {nodef(shift,"log")}
  704 sub sin     {nodef(shift,"sin")}
  705 sub cos     {nodef(shift,"cos")}
  706 
  707 #
  708 #  If the right operand is higher precedence, we switch the order.
  709 #
  710 #  If the right operand is also a Value object, we do the object's
  711 #  dot method to combine the two objects of the same class.
  712 #
  713 #  Otherwise, since . is used for string concatenation, we want to retain
  714 #  that.  Since the resulting string is often used in Formula and will be
  715 #  parsed again, we put parentheses around the values to guarantee that
  716 #  the values will be treated as one mathematical unit.  For example, if
  717 #  $f = Formula("1+x") and $g = Formula("y") then Formula("$f/$g") will be
  718 #  (1+x)/y not 1+(x/y), as it would be without the implicit parentheses.
  719 #
  720 sub _dot {
  721   my ($l,$r,$flag) = @_;
  722   return $r->_dot($l,!$flag) if ($l->promotePrecedence($r));
  723   return $l->dot($r,$flag) if (Value::isValue($r));
  724   if ($l->getFlag('StringifyAsTeX')) {$l = $l->TeX} else {$l = $l->pdot}
  725   return ($flag)? ($r.$l): ($l.$r);
  726 }
  727 #
  728 #  Some classes override this
  729 #
  730 sub dot {
  731   my ($l,$r,$flag) = @_;
  732   my $tex = $l->getFlag('StringifyAsTeX');
  733   if ($tex) {$l = $l->TeX} else {$l = $l->pdot}
  734   if (ref($r)) {if ($tex) {$r = $r->TeX} else {$r = $r->pdot}}
  735   return ($flag)? ($r.$l): ($l.$r);
  736 }
  737 
  738 #
  739 #  Some classes override this to add parens
  740 #
  741 sub pdot {shift->stringify}
  742 
  743 
  744 #
  745 #  Compare the values of the objects
  746 #    (list classes should replace this)
  747 #
  748 sub compare {
  749   my ($l,$r) = Value::checkOpOrder(@_);
  750   return $l->value <=> $r->value;
  751 }
  752 
  753 #
  754 #  Compare the values as strings
  755 #
  756 sub compare_string {
  757   my ($l,$r,$flag) = @_;
  758   $l = $l->stringify; $r = $r->stringify if Value::isValue($r);
  759   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  760   return $l cmp $r;
  761 }
  762 
  763 =head3 output methods for MathObjects
  764 
  765  #
  766  #  Generate the various output formats
  767  #  (can be replaced by sub-classes)
  768  #
  769 
  770 =cut
  771 
  772 =head4 stringify
  773 
  774   Usage:   TEXT($mathObj); or TEXT( $mathObj->stringify() ) ;
  775 
  776     Produces text string or TeX output depending on context
  777       Context()->texStrings;
  778       Context()->normalStrings;
  779 
  780     called automatically when object is called in a string context.
  781 
  782 =cut
  783 
  784 sub stringify {
  785   my $self = shift;
  786   return $self->TeX() if $self->getFlag('StringifyAsTeX');
  787   my $def = $self->context->lists->get($self->class);
  788   return $self->string unless $def;
  789   my $open = $self->{open};   $open  = $def->{open}  unless defined($open);
  790   my $close = $self->{close}; $close = $def->{close} unless defined($close);
  791   $open.join($def->{separator},@{$self->data}).$close;
  792 }
  793 
  794 =head4 ->string
  795 
  796   Usage: $mathObj->string()
  797 
  798   ---produce a string representation of the object
  799            (as opposed to stringify, which can produce TeX or string versions)
  800 
  801 =cut
  802 
  803 sub string {
  804   my $self = shift; my $equation = shift;
  805   my $def = ($equation->{context} || $self->context)->lists->get($self->class);
  806   return $self->value unless $def;
  807   my $open = shift; my $close = shift;
  808   $open  = $self->{open}  unless defined($open);
  809   $open  = $def->{open}   unless defined($open);
  810   $close = $self->{close} unless defined($close);
  811   $close = $def->{close}  unless defined($close);
  812   my @coords = ();
  813   foreach my $x (@{$self->data}) {
  814     if (Value::isValue($x))
  815       {push(@coords,$x->string($equation))} else {push(@coords,$x)}
  816   }
  817   return $open.join($def->{separator},@coords).$close;
  818 }
  819 
  820 =head4 ->TeX
  821 
  822   Usage: $mathObj->TeX()
  823 
  824   ---produce TeX prepresentation of the object
  825 
  826 =cut
  827 
  828 sub TeX {
  829   my $self = shift; my $equation = shift;
  830   my $context = $equation->{context} || $self->context;
  831   my $def = $context->lists->get($self->class);
  832   return $self->string(@_) unless $def;
  833   my $open = shift; my $close = shift;
  834   $open  = $self->{open}  unless defined($open);
  835   $open  = $def->{open}   unless defined($open);
  836   $close = $self->{close} unless defined($close);
  837   $close = $def->{close}  unless defined($close);
  838   $open =~ s/([{}])/\\$1/g; $close =~ s/([{}])/\\$1/g;
  839   $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  840   my @coords = (); my $str = $context->{strings};
  841   foreach my $x (@{$self->data}) {
  842     if (Value::isValue($x)) {push(@coords,$x->TeX($equation))}
  843     elsif (defined($str->{$x}) && $str->{$x}{TeX}) {push(@coords,$str->{$x}{TeX})}
  844     else {push(@coords,$x)}
  845   }
  846   return $open.join(',',@coords).$close;
  847 }
  848 
  849 #
  850 #  For perl, call the appropriate constructor around the object's data
  851 #
  852 sub perl {
  853   my $self = shift; my $parens = shift; my $matrix = shift;
  854   my $class = $self->class;
  855   my $mtype = $class eq 'Matrix'; $mtype = -1 if $mtype & !$matrix;
  856   my $perl; my @p = ();
  857   foreach my $x (@{$self->data}) {
  858     if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)}
  859   }
  860   @p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $class eq 'Interval';
  861   if ($matrix) {
  862     $perl = join(',',@p);
  863     $perl = '['.$perl.']' if $mtype > 0;
  864   } else {
  865     $perl = 'new '.ref($self).'('.join(',',@p).')';
  866     $perl = "($perl)->with(open=>'$self->{open}',close=>'$self->{close}')"
  867       if $class eq 'List' && $self->{open}.$self->{close} ne '()';
  868     $perl = '('.$perl.')' if $parens == 1;
  869   }
  870   return $perl;
  871 }
  872 
  873 #
  874 #  Stubs for when called by Parser
  875 #
  876 sub eval {shift}
  877 sub reduce {shift}
  878 
  879 sub ijk {
  880   Value::Error("Can't use method 'ijk' with objects of type '%s'",(shift)->class);
  881 }
  882 
  883 
  884 =head3 Error
  885 
  886   Usage: $mathObj->Error("We're sorry...");
  887 
  888  #
  889  #  Report an error
  890  #
  891 
  892 =cut
  893 
  894 sub Error {
  895   my $message = shift;
  896   $message = [$message,@_] if scalar(@_) > 0;
  897   $$context->setError($message,'');
  898   $message = $$context->{error}{message};
  899   die $message . traceback() if $$context->flags('showTraceback');
  900   die $message . getCaller();
  901 }
  902 
  903 #
  904 #  Try to locate the line and file where the error occurred
  905 #
  906 sub getCaller {
  907   my $frame = 2;
  908   while (my ($pkg,$file,$line,$subname) = caller($frame++)) {
  909     return " at line $line of $file\n"
  910       unless $pkg =~ /^(Value|Parser)/ ||
  911              $subname =~ m/^(Value|Parser).*(new|call)$/;
  912   }
  913   return "";
  914 }
  915 
  916 #
  917 #  For debugging
  918 #
  919 sub traceback {
  920   my $frame = shift; $frame = 2 unless defined($frame);
  921   my $trace = '';
  922   while (my ($pkg,$file,$line,$subname) = caller($frame++))
  923     {$trace .= " in $subname at line $line of $file\n"}
  924   return $trace;
  925 }
  926 
  927 ###########################################################################
  928 #
  929 #  Load the sub-classes.
  930 #
  931 
  932 END {
  933   use Value::Real;
  934   use Value::Complex;
  935   use Value::Infinity;
  936   use Value::Point;
  937   use Value::Vector;
  938   use Value::Matrix;
  939   use Value::List;
  940   use Value::Interval;
  941   use Value::Set;
  942   use Value::Union;
  943   use Value::String;
  944   use Value::Formula;
  945 
  946   use Value::WeBWorK;  # stuff specific to WeBWorK
  947 }
  948 
  949 ###########################################################################
  950 
  951 our $installed = 1;
  952 
  953 ###########################################################################
  954 
  955 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9