[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 5042 - (download) (as text) (annotate)
Thu Jun 28 01:31:09 2007 UTC (12 years, 6 months ago) by dpvc
File size: 26565 byte(s)
Recent changes to automatically do promotion in the Value methods was
a mistake.  I put it back into the subclass methods again.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9