[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 5236 - (download) (as text) (annotate)
Tue Aug 7 04:27:35 2007 UTC (12 years, 6 months ago) by dpvc
File size: 27564 byte(s)
Fixed an error in the documentation.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9