[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 5099 - (download) (as text) (annotate)
Sat Jun 30 15:02:17 2007 UTC (12 years, 7 months ago) by dpvc
File size: 27090 byte(s)
Make sure classMatch always has a Context object, and don't report
Package errors in this routine.

    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 : Value->context);
  261   foreach my $name (@_) {
  262     return 1 if $class eq $name || $ref eq $context->Package($name,1) ||
  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 classMatch($n,'Real','Complex') || 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        {transferTolerances(@_); 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 (Value->context->flag('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 = Value->context->flag('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 #
  780 #  Copy flags from the parent object to its children (recursively).
  781 #
  782 sub transferFlags {
  783   my $self = shift;
  784   foreach my $flag (@_) {
  785     next unless defined $self->{$flag};
  786     foreach my $x (@{$self->{data}}) {
  787       if ($x->{$flag} ne $self->{$flag}) {
  788   $x->{$flag} = $self->{$flag};
  789   $x->transferFlags($flag);
  790       }
  791     }
  792   }
  793 }
  794 
  795 sub transferTolerances {
  796   my ($self,$other) = @_;
  797   $self->transferFlags("tolerance","tolType","zeroLevel","zeroLevelTol");
  798   $other->transferFlags("tolerance","tolType","zeroLevel","zeroLevelTol") if Value::isValue($other);
  799 }
  800 
  801 =head3 output methods for MathObjects
  802 
  803  #
  804  #  Generate the various output formats
  805  #  (can be replaced by sub-classes)
  806  #
  807 
  808 =cut
  809 
  810 =head4 stringify
  811 
  812   Usage:   TEXT($mathObj); or TEXT( $mathObj->stringify() ) ;
  813 
  814     Produces text string or TeX output depending on context
  815       Context()->texStrings;
  816       Context()->normalStrings;
  817 
  818     called automatically when object is called in a string context.
  819 
  820 =cut
  821 
  822 sub stringify {
  823   my $self = shift;
  824   return $self->TeX if Value->context->flag('StringifyAsTeX');
  825   return $self->string;
  826 }
  827 
  828 =head4 ->string
  829 
  830   Usage: $mathObj->string()
  831 
  832   ---produce a string representation of the object
  833            (as opposed to stringify, which can produce TeX or string versions)
  834 
  835 =cut
  836 
  837 sub string {
  838   my $self = shift; my $equation = shift;
  839   my $def = ($equation->{context} || $self->context)->lists->get($self->class);
  840   return $self->value unless $def;
  841   my $open = shift; my $close = shift;
  842   $open  = $self->{open}  unless defined($open);
  843   $open  = $def->{open}   unless defined($open);
  844   $close = $self->{close} unless defined($close);
  845   $close = $def->{close}  unless defined($close);
  846   my @coords = ();
  847   foreach my $x (@{$self->data}) {
  848     if (Value::isValue($x)) {
  849       $x->{format} = $self->{format} if defined $self->{format};
  850       push(@coords,$x->string($equation));
  851     } else {
  852       push(@coords,$x);
  853     }
  854   }
  855   return $open.join($def->{separator},@coords).$close;
  856 }
  857 
  858 =head4 ->TeX
  859 
  860   Usage: $mathObj->TeX()
  861 
  862   ---produce TeX prepresentation of the object
  863 
  864 =cut
  865 
  866 sub TeX {
  867   my $self = shift; my $equation = shift;
  868   my $context = $equation->{context} || $self->context;
  869   my $def = $context->lists->get($self->class);
  870   return $self->string(@_) unless $def;
  871   my $open = shift; my $close = shift;
  872   $open  = $self->{open}  unless defined($open);
  873   $open  = $def->{open}   unless defined($open);
  874   $close = $self->{close} unless defined($close);
  875   $close = $def->{close}  unless defined($close);
  876   $open =~ s/([{}])/\\$1/g; $close =~ s/([{}])/\\$1/g;
  877   $open = '\left'.$open if $open; $close = '\right'.$close if $close;
  878   my @coords = (); my $str = $context->{strings};
  879   foreach my $x (@{$self->data}) {
  880     if (Value::isValue($x)) {
  881       $x->{format} = $self->{format} if defined $self->{format};
  882       push(@coords,$x->TeX($equation));
  883     } elsif (defined($str->{$x}) && $str->{$x}{TeX}) {push(@coords,$str->{$x}{TeX})}
  884     else {push(@coords,$x)}
  885   }
  886   return $open.join(',',@coords).$close;
  887 }
  888 
  889 #
  890 #  For perl, call the appropriate constructor around the object's data
  891 #
  892 sub perl {
  893   my $self = shift; my $parens = shift; my $matrix = shift;
  894   my $mtype = $self->classMatch('Matrix'); $mtype = -1 if $mtype & !$matrix;
  895   my $perl; my @p = ();
  896   foreach my $x (@{$self->data}) {
  897     if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)}
  898   }
  899   @p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $self->classMatch('Interval');
  900   if ($matrix) {
  901     $perl = join(',',@p);
  902     $perl = '['.$perl.']' if $mtype > 0;
  903   } else {
  904     $perl = ref($self).'->new('.join(',',@p).')';
  905     $perl = "($perl)->with(open=>'$self->{open}',close=>'$self->{close}')"
  906       if $self->classMatch('List') && $self->{open}.$self->{close} ne '()';
  907     $perl = '('.$perl.')' if $parens == 1;
  908   }
  909   return $perl;
  910 }
  911 
  912 #
  913 #  Stubs for when called by Parser
  914 #
  915 sub eval {shift}
  916 sub reduce {shift}
  917 
  918 sub ijk {
  919   Value::Error("Can't use method 'ijk' with objects of type '%s'",(shift)->class);
  920 }
  921 
  922 
  923 =head3 Error
  924 
  925   Usage: $mathObj->Error("We're sorry...");
  926 
  927  #
  928  #  Report an error
  929  #
  930 
  931 =cut
  932 
  933 sub Error {
  934   my $message = shift; my $context = Value->context;
  935   $message = [$message,@_] if scalar(@_) > 0;
  936   $context->setError($message,'');
  937   $message = $context->{error}{message};
  938   die $message . traceback() if $context->flags('showTraceback');
  939   die $message . getCaller();
  940 }
  941 
  942 #
  943 #  Try to locate the line and file where the error occurred
  944 #
  945 sub getCaller {
  946   my $frame = 2;
  947   while (my ($pkg,$file,$line,$subname) = caller($frame++)) {
  948     return " at line $line of $file\n"
  949       unless $pkg =~ /^(Value|Parser)/ ||
  950              $subname =~ m/^(Value|Parser).*(new|call)$/;
  951   }
  952   return "";
  953 }
  954 
  955 #
  956 #  For debugging
  957 #
  958 sub traceback {
  959   my $frame = shift; $frame = 2 unless defined($frame);
  960   my $trace = '';
  961   while (my ($pkg,$file,$line,$subname) = caller($frame++))
  962     {$trace .= " in $subname at line $line of $file\n"}
  963   return $trace;
  964 }
  965 
  966 ###########################################################################
  967 #
  968 #  Load the sub-classes.
  969 #
  970 
  971 END {
  972   use Value::Real;
  973   use Value::Complex;
  974   use Value::Infinity;
  975   use Value::Point;
  976   use Value::Vector;
  977   use Value::Matrix;
  978   use Value::List;
  979   use Value::Interval;
  980   use Value::Set;
  981   use Value::Union;
  982   use Value::String;
  983   use Value::Formula;
  984 
  985   use Value::WeBWorK;  # stuff specific to WeBWorK
  986 }
  987 
  988 ###########################################################################
  989 
  990 our $installed = 1;
  991 
  992 ###########################################################################
  993 
  994 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9