File:  [LON-CAPA] / loncom / homework / math_parser / ENode.pm
Revision 1.2: download - view: text, annotated - select for diffs
Mon Jun 29 17:47:00 2015 UTC (8 years, 10 months ago) by damieng
Branches: MAIN
CVS tags: HEAD
using Switch package instead of given (perl 5.10.1) to preserve compatibility with CentOS 5

    1: # The LearningOnline Network with CAPA - LON-CAPA
    2: # Parsed tree node
    3: #
    4: # Copyright (C) 2014 Michigan State University Board of Trustees
    5: #
    6: # This program is free software: you can redistribute it and/or modify
    7: # it under the terms of the GNU General Public License as published by
    8: # the Free Software Foundation, either version 3 of the License, or
    9: # (at your option) any later version.
   10: #
   11: # This program is distributed in the hope that it will be useful,
   12: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   13: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
   14: # GNU General Public License for more details.
   15: #
   16: # You should have received a copy of the GNU General Public License
   17: # along with this program. If not, see <http://www.gnu.org/licenses/>.
   18: #
   19: 
   20: ##
   21: # Parsed tree node. ENode.toMathML(hcolors) contains the code for the transformation into MathML.
   22: ##
   23: package Apache::math_parser::ENode;
   24: 
   25: use strict;
   26: use warnings;
   27: use utf8;
   28: 
   29: use Switch 'Perl6';
   30: 
   31: use aliased 'Apache::math_parser::CalcException';
   32: use aliased 'Apache::math_parser::Operator';
   33: use aliased 'Apache::math_parser::ParseException';
   34: use aliased 'Apache::math_parser::QMatrix';
   35: use aliased 'Apache::math_parser::Quantity';
   36: use aliased 'Apache::math_parser::QVector';
   37: use aliased 'Apache::math_parser::QInterval';
   38: use aliased 'Apache::math_parser::QIntervalUnion';
   39: use aliased 'Apache::math_parser::QSet';
   40: use aliased 'Apache::math_parser::Units';
   41: 
   42: use enum qw(UNKNOWN NAME NUMBER OPERATOR FUNCTION VECTOR INTERVAL SET SUBSCRIPT);
   43: use enum qw(NOT_AN_INTERVAL OPEN_OPEN OPEN_CLOSED CLOSED_OPEN CLOSED_CLOSED);
   44: 
   45: ##
   46: # @param {integer} type - UNKNOWN | NAME | NUMBER | OPERATOR | FUNCTION | VECTOR | INTERVAL | SET | SUBSCRIPT
   47: # @param {Operator} op - The operator
   48: # @param {string} value - Node value as a string, undef for type VECTOR
   49: # @param {ENode[]} children - The children nodes, only for types OPERATOR, FUNCTION, VECTOR, INTERVAL, SET, SUBSCRIPT
   50: # @param {interval_type} - The interval type, NOT_AN_INTERVAL | OPEN_OPEN | OPEN_CLOSED | CLOSED_OPEN | CLOSED_CLOSED
   51: ##
   52: sub new {
   53:     my $class = shift;
   54:     my $self = {
   55:         _type => shift,
   56:         _op => shift,
   57:         _value => shift,
   58:         _children => shift,
   59:         _interval_type => shift // NOT_AN_INTERVAL,
   60:     };
   61:     bless $self, $class;
   62:     return $self;
   63: }
   64: 
   65: # Attribute helpers
   66: 
   67: ##
   68: # Node type
   69: # @returns {int} UNKNOWN | NAME | NUMBER | OPERATOR | FUNCTION | VECTOR | INTERVAL | SET | SUBSCRIPT
   70: ##
   71: sub type {
   72:     my $self = shift;
   73:     return $self->{_type};
   74: }
   75: 
   76: ##
   77: # Operator
   78: # @returns {Operator}
   79: ##
   80: sub op {
   81:     my $self = shift;
   82:     return $self->{_op};
   83: }
   84: 
   85: ##
   86: # Node value as a string, undef for type VECTOR.
   87: # @returns {string}
   88: ##
   89: sub value {
   90:     my $self = shift;
   91:     return $self->{_value};
   92: }
   93: 
   94: ##
   95: # The children nodes, only for types OPERATOR, FUNCTION, VECTOR, INTERVAL, SET, SUBSCRIPT
   96: # @returns {ENode[]}
   97: ##
   98: sub children {
   99:     my $self = shift;
  100:     return $self->{_children};
  101: }
  102: 
  103: ##
  104: # The interval type, NOT_AN_INTERVAL | OPEN_OPEN | OPEN_CLOSED | CLOSED_OPEN | CLOSED_CLOSED
  105: # @returns {int}
  106: ##
  107: sub interval_type {
  108:     my $self = shift;
  109:     return $self->{_interval_type};
  110: }
  111: 
  112: 
  113: ##
  114: # Returns the node as a string, for debug
  115: # @returns {string}
  116: ##
  117: sub toString {
  118:     my ( $self ) = @_;
  119:     my $s = '(';
  120:     given ($self->type) {
  121:         when (UNKNOWN) { $s .= "UNKNOWN"; }
  122:         when (NAME) { $s .= "NAME"; }
  123:         when (NUMBER) { $s .= "NUMBER"; }
  124:         when (OPERATOR) { $s .= "OPERATOR"; }
  125:         when (FUNCTION) { $s .= "FUNCTION"; }
  126:         when (VECTOR) { $s .= "VECTOR"; }
  127:         when (INTERVAL) { $s .= "INTERVAL"; }
  128:         when (SET) { $s .= "SET"; }
  129:         when (SUBSCRIPT) { $s .= "SUBSCRIPT"; }
  130:     }
  131:     if (defined $self->op) {
  132:         $s .= " '" . $self->op->id . "'";
  133:     }
  134:     if (defined $self->value) {
  135:         $s .= " '" . $self->value . "'";
  136:     }
  137:     if (defined $self->{_children}) {
  138:         $s .= ' [';
  139:         for (my $i = 0; $i < scalar(@{$self->children}); $i++) {
  140:             $s .= $self->children->[$i]->toString();
  141:             if ($i != scalar(@{$self->children}) - 1) {
  142:                 $s .= ',';
  143:             }
  144:         }
  145:         $s .= ']';
  146:     }
  147:     if (defined $self->interval_type) {
  148:         $s .= " " . $self->interval_type;
  149:     }
  150:     $s.= ')';
  151:     return $s;
  152: }
  153: 
  154: ##
  155: # Evaluates the node, returning a quantity or an object from a more complex class using quantities as base components.
  156: # Can throw a CalcException if a result cannot be calculated.
  157: # @param {CalcEnv} env - Calculation environment.
  158: # @returns {Quantity|QVector|QMatrix|QSet|QInterval|QIntervalUnion}
  159: ##
  160: sub calc {
  161:     my ( $self, $env ) = @_;
  162:     
  163:     given ($self->type) {
  164:         when (UNKNOWN) {
  165:             die CalcException->new("Unknown node type: [_1].", $self->value);
  166:         }
  167:         when (NAME) {
  168:             my $name = $self->value;
  169:             if ($name =~ /^inf$/i) {
  170:                 return Quantity->new(9**9**9);
  171:             } elsif ($name =~ /^nan$/i) {
  172:                 return Quantity->new(-sin(9**9**9));
  173:             }
  174:             if ($env->unit_mode) {
  175:                 my $cst = $env->getConstant($name);
  176:                 if (defined $cst) {
  177:                     return $cst;
  178:                 }
  179:                 return $env->convertToSI($name);
  180:             } else {
  181:                 my $q = $env->getVariable($name);
  182:                 if (!defined $q) {
  183:                     my $cst = $env->getConstant($name);
  184:                     if (defined $cst) {
  185:                         return $cst;
  186:                     }
  187:                     die CalcException->new("Variable has undefined value: [_1].", $name);
  188:                 }
  189:                 return $q;
  190:             }
  191:         }
  192:         when (NUMBER) {
  193:             return Quantity->new($self->value);
  194:         }
  195:         when (OPERATOR) {
  196:             my @children = @{$self->children};
  197:             my ($q1, $q2);
  198:             if (defined $children[0]) {
  199:                 $q1 = $children[0]->calc($env);
  200:             }
  201:             if (defined $children[1]) {
  202:                 $q2 = $children[1]->calc($env);
  203:             }
  204:             given ($self->value) {
  205:                 when ("+") {
  206:                     if (!overload::Method($q1, '+')) {
  207:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  208:                     }
  209:                     return($q1 + $q2);
  210:                 }
  211:                 when ("-") {
  212:                     if (!defined $q2) {
  213:                         if (!$q1->can('qneg')) {
  214:                             die CalcException->new("Negation is not implemented for this type.");
  215:                         }
  216:                         return($q1->qneg());
  217:                     } else {
  218:                         if (!overload::Method($q1, '-')) {
  219:                             die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  220:                         }
  221:                         return($q1 - $q2);
  222:                     }
  223:                 }
  224:                 when ("*") {
  225:                     if (!overload::Method($q1, '*')) {
  226:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  227:                     }
  228:                     return($q1 * $q2);
  229:                 }
  230:                 when ("/") {
  231:                     if (!overload::Method($q1, '/')) {
  232:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  233:                     }
  234:                     return($q1 / $q2);
  235:                 }
  236:                 when ("^") {
  237:                     if (!overload::Method($q1, '^')) {
  238:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  239:                     }
  240:                     return($q1 ^ $q2);
  241:                 }
  242:                 when ("!") {
  243:                     if (!$q1->can('qfact')) {
  244:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  245:                     }
  246:                     return $q1->qfact();
  247:                 }
  248:                 when ("%") {
  249:                     if (!$q1->isa(Quantity) || !$q2->isa(Quantity)) {
  250:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  251:                     }
  252:                     return(($q1 / Quantity->new(100)) * $q2);
  253:                 }
  254:                 when (".") {
  255:                     # scalar product for vectors, multiplication for matrices
  256:                     if (!$q1->can('qdot')) {
  257:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  258:                     }
  259:                     return($q1->qdot($children[1]->calc($env)));
  260:                 }
  261:                 when ("`") {
  262:                     if (!overload::Method($q1, '*')) {
  263:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  264:                     }
  265:                     return($q1 * $q2);
  266:                 }
  267:                 when ("=") {
  268:                     if (!$q1->can('qeq')) {
  269:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  270:                     }
  271:                     return($q1->qeq($q2, $env->tolerance));
  272:                 }
  273:                 when ("<") {
  274:                     if (!overload::Method($q1, '<')) {
  275:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  276:                     }
  277:                     return($q1 < $q2);
  278:                 }
  279:                 when ("<=") {
  280:                     if (!overload::Method($q1, '<=')) {
  281:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  282:                     }
  283:                     return($q1 <= $q2);
  284:                 }
  285:                 when (">") {
  286:                     if (!overload::Method($q1, '>')) {
  287:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  288:                     }
  289:                     return($q1 > $q2);
  290:                 }
  291:                 when (">=") {
  292:                     if (!overload::Method($q1, '>=')) {
  293:                         die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
  294:                     }
  295:                     return($q1 >= $q2);
  296:                 }
  297:                 default {
  298:                     die CalcException->new("Unknown operator: [_1].", $self->value);
  299:                 }
  300:             }
  301:         }
  302:         when (FUNCTION) {
  303:             my @children = @{$self->children};
  304:             my $fname = $children[0]->value;
  305:             
  306:             if (!defined $children[1]) {
  307:                 die CalcException->new("Missing parameter for function [_1].", $fname);
  308:             }
  309:             my ($q1, $q2);
  310:             if ($fname ~~ ['pow', 'sqrt', 'abs', 'exp', 'ln', 'log', 'log10', 'factorial',
  311:                     'mod', 'sgn', 'ceil', 'floor', 'sin', 'cos', 'tan', 'asin', 'acos', 'atan',
  312:                     'atan2', 'sinh', 'cosh', 'tanh', 'asinh', 'acosh', 'atanh']) {
  313:                 $q1 = $children[1]->calc($env);
  314:                 if (!$q1->isa(Quantity)) {
  315:                     die CalcException->new("The [_1] function is not implemented for this type.", $fname);
  316:                 }
  317:             }
  318:             if ($fname ~~ ['pow', 'mod', 'atan2']) {
  319:                 if (!defined $children[2]) {
  320:                     die CalcException->new("Missing parameter for function [_1].", $fname);
  321:                 }
  322:                 $q2 = $children[2]->calc($env);
  323:                 if (!$q2->isa(Quantity)) {
  324:                     die CalcException->new("The [_1] function is not implemented for this type.", $fname);
  325:                 }
  326:             }
  327:             given ($fname) {
  328:                 when ("matrix") {    return $self->createVectorOrMatrix($env); }
  329:                 when ("pow") {       return $q1->qpow($q2); }
  330:                 when ("sqrt") {      return $q1->qsqrt(); }
  331:                 when ("abs") {       return $q1->qabs(); }
  332:                 when ("exp") {       return $q1->qexp(); }
  333:                 when ("ln") {        return $q1->qln(); }
  334:                 when ("log") {       return $q1->qln(); }
  335:                 when ("log10") {     return $q1->qlog10(); }
  336:                 when ("factorial") { return $q1->qfact(); }
  337:                 when ("mod") {       return $q1->qmod($q2); }
  338:                 when ("sgn") {       return $q1->qsgn(); }
  339:                 when ("ceil") {      return $q1->qceil(); }
  340:                 when ("floor") {     return $q1->qfloor(); }
  341:                 when ("sin") {       return $q1->qsin(); }
  342:                 when ("cos") {       return $q1->qcos(); }
  343:                 when ("tan") {       return $q1->qtan(); }
  344:                 when ("asin") {      return $q1->qasin(); }
  345:                 when ("acos") {      return $q1->qacos(); }
  346:                 when ("atan") {      return $q1->qatan(); }
  347:                 when ("atan2") {     return $q1->qatan2($q2); }
  348:                 when ("sinh") {      return $q1->qsinh(); }
  349:                 when ("cosh") {      return $q1->qcosh(); }
  350:                 when ("tanh") {      return $q1->qtanh(); }
  351:                 when ("asinh") {     return $q1->qasinh(); }
  352:                 when ("acosh") {     return $q1->qacosh(); }
  353:                 when ("atanh") {     return $q1->qatanh(); }
  354:                 when (["sum","product"]) {
  355:                     if ($env->unit_mode) {
  356:                         die CalcException->new("[_1] cannot work in unit mode.", $fname);
  357:                     }
  358:                     if (scalar(@children) != 5) {
  359:                         die CalcException->new("[_1] should have four parameters.", $fname);
  360:                     }
  361:                     my $var = "".$children[2]->value;
  362:                     if ($var !~ /^[a-zA-Z_][a-zA-Z_0-9]*$/) {
  363:                         die CalcException->new("[_1]: wrong variable name", $fname);
  364:                     }
  365:                     if ($var eq "i") {
  366:                         die CalcException->new("[_1]: please use another variable name, i is the imaginary number.", $fname);
  367:                     }
  368:                     my $initial = $env->getVariable($var);
  369:                     my $var_value_1 = $children[3]->value;
  370:                     my $var_value_2 = $children[4]->value;
  371:                     if ($var_value_1 !~ /^[0-9]+$/) {
  372:                         die CalcException->new("[_1]: the third parameter should be an integer", $fname);
  373:                     }
  374:                     if ($var_value_2 !~ /^[0-9]+$/) {
  375:                         die CalcException->new("[_1]: the fourth parameter should be an integer", $fname);
  376:                     }
  377:                     if ($var_value_1 > $var_value_2) {
  378:                         die CalcException->new("[_1]: are you trying to make me loop forever?", $fname);
  379:                     }
  380:                     my $result;
  381:                     for (my $var_value=$var_value_1; $var_value <= $var_value_2; $var_value++) {
  382:                         $env->setVariable($var, $var_value);
  383:                         my $nq = $children[1]->calc($env);
  384:                         if (!$nq->isa(Quantity) && !$nq->isa(QVector) && !$nq->isa(QMatrix)) {
  385:                             die CalcException->new("[_1]: wrong type for a calculated value", $fname);
  386:                         }
  387:                         if (!defined $result) {
  388:                             $result = $nq;
  389:                         } elsif ($fname eq "sum") {
  390:                             $result += $nq;
  391:                         } else {
  392:                             $result *= $nq;
  393:                         }
  394:                     }
  395:                     $env->setVariable($var, $initial);
  396:                     return $result;
  397:                 }
  398:                 when ("binomial") {
  399:                     if (scalar(@children) != 3) {
  400:                         die CalcException->new("[_1] should have two parameters.", $fname);
  401:                     }
  402:                     my $n = $children[1]->calc($env);
  403:                     my $p = $children[2]->calc($env);
  404:                     if (!$n->isa(Quantity) || !$p->isa(Quantity)) {
  405:                         die CalcException->new("Wrong parameter type for function [_1]", $fname);
  406:                     }
  407:                     return $n->qfact() / ($p->qfact() * ($n - $p)->qfact());
  408:                 }
  409:                 when (["union","intersection"]) {
  410:                     if (!defined $children[2]) {
  411:                         die CalcException->new("Missing parameter for function [_1].", $fname);
  412:                     }
  413:                     my $p1 = $children[1]->calc($env);
  414:                     my $p2 = $children[2]->calc($env);
  415:                     if (!$p1->isa(QSet) && !$p1->isa(QInterval) && !$p1->isa(QIntervalUnion)) {
  416:                         die CalcException->new("Wrong type for function [_1] (should be a set or interval).", $fname);
  417:                     }
  418:                     if ($fname eq "union") {
  419:                         return $p1->union($p2);
  420:                     } else {
  421:                         return $p1->intersection($p2);
  422:                     }
  423:                 }
  424:                 default {            die CalcException->new("Unknown function: [_1].",$fname); }
  425:             }
  426:         }
  427:         when (VECTOR) {
  428:             return $self->createVectorOrMatrix($env);
  429:         }
  430:         when (INTERVAL) {
  431:             my @children = @{$self->children};
  432:             if (scalar(@children) != 2) {
  433:                 die CalcException->new("Interval should have two parameters.");
  434:             }
  435:             my $qmin = $children[0]->calc($env);
  436:             my $qmax = $children[1]->calc($env);
  437:             my ($qminopen, $qmaxopen);
  438:             given ($self->interval_type) {
  439:                 when (OPEN_OPEN) { $qminopen = 1; $qmaxopen = 1; }
  440:                 when (OPEN_CLOSED) { $qminopen = 1; $qmaxopen = 0; }
  441:                 when (CLOSED_OPEN) { $qminopen = 0; $qmaxopen = 1; }
  442:                 when (CLOSED_CLOSED) { $qminopen = 0; $qmaxopen = 0; }
  443:             }
  444:             return QInterval->new($qmin, $qmax, $qminopen, $qmaxopen);
  445:         }
  446:         when (SET) {
  447:             my @t = ();
  448:             foreach my $child (@{$self->children}) {
  449:                 push(@t, $child->calc($env));
  450:             }
  451:             return QSet->new(\@t);
  452:         }
  453:         when (SUBSCRIPT) {
  454:             die CalcException->new("Subscript cannot be evaluated: [_1].", $self->value);
  455:         }
  456:     }
  457: }
  458: 
  459: ##
  460: # Returns the equation as a string with the Maxima syntax.
  461: # @returns {string}
  462: ##
  463: sub toMaxima {
  464:     my ( $self, $env ) = @_;
  465:     
  466:     given ($self->type) {
  467:         when (UNKNOWN) {
  468:             die CalcException->new("Unknown node type: [_1].", $self->value);
  469:         }
  470:         when (NAME) {
  471:             my $name = $self->value;
  472:             my $cst = $env->getConstant($name);
  473:             if (defined $cst) {
  474:                 return $cst;
  475:             }
  476:             return($name);
  477:         }
  478:         when (NUMBER) {
  479:             if ($self->value eq "i") {
  480:                 return "%i";
  481:             } else {
  482:                 return $self->value;
  483:             }
  484:         }
  485:         when (OPERATOR) {
  486:             my @children = @{$self->children};
  487:             given ($self->value) {
  488:                 when ("+") {
  489:                     if ($children[0]->type == SET && $children[1]->type == SET) {
  490:                         return("union(".$children[0]->toMaxima().", ".$children[1]->toMaxima().")");
  491:                     } else {
  492:                         return("(".$children[0]->toMaxima()."+".$children[1]->toMaxima().")");
  493:                     }
  494:                 }
  495:                 when ("-") {
  496:                     if (!defined $children[1]) {
  497:                         return("(-".$children[0]->toMaxima().")");
  498:                     } else {
  499:                         return("(".$children[0]->toMaxima()."-".$children[1]->toMaxima().")");
  500:                     }
  501:                 }
  502:                 when ("*") {
  503:                     return("(".$children[0]->toMaxima()."*".$children[1]->toMaxima().")");
  504:                 }
  505:                 when ("/") {
  506:                     return("(".$children[0]->toMaxima()."/".$children[1]->toMaxima().")");
  507:                 }
  508:                 when ("^") {
  509:                     return("(".$children[0]->toMaxima()."^".$children[1]->toMaxima().")");
  510:                 }
  511:                 when ("!") {
  512:                     return("factorial(".$children[0]->toMaxima().")");
  513:                 }
  514:                 when ("%") {
  515:                     return("((".$children[0]->toMaxima()."/100)*".$children[1]->toMaxima().")");
  516:                 }
  517:                 when (".") {
  518:                     # scalar product for vectors, multiplication for matrices
  519:                     return("(".$children[0]->toMaxima().".".$children[1]->toMaxima().")");
  520:                 }
  521:                 when ("`") {
  522:                     return("(".$children[0]->toMaxima()."`".$children[1]->toMaxima().")");
  523:                 }
  524:                 when ("=") {
  525:                     # NOTE: should we use is(...) to evaluate the expression ?
  526:                     return("(".$children[0]->toMaxima()."=".$children[1]->toMaxima().")");
  527:                 }
  528:                 when ("<") {
  529:                     return("(".$children[0]->toMaxima()."<".$children[1]->toMaxima().")");
  530:                 }
  531:                 when (">") {
  532:                     return("(".$children[0]->toMaxima().">".$children[1]->toMaxima().")");
  533:                 }
  534:                 when ("<=") {
  535:                     return("(".$children[0]->toMaxima()."<=".$children[1]->toMaxima().")");
  536:                 }
  537:                 when (">=") {
  538:                     return("(".$children[0]->toMaxima().">=".$children[1]->toMaxima().")");
  539:                 }
  540:                 default {
  541:                     die CalcException->new("Unknown operator: [_1].", $self->value);
  542:                 }
  543:             }
  544:         }
  545:         when (FUNCTION) {
  546:             my @children = @{$self->children};
  547:             my $fname = $children[0]->value;
  548:             
  549:             given ($fname) {
  550:                 when ("log10") {  return "log(".$children[1]->toMaxima().")/log(10)"; }
  551:                 when ("sgn") {    return "signum(".$children[1]->toMaxima().")"; }
  552:                 when ("ceil") {   return "ceiling(".$children[1]->toMaxima().")"; }
  553:                 default {
  554:                     my $s = $fname."(";
  555:                     for (my $i=1; $i<scalar(@children); $i++) {
  556:                         if ($i != 1) {
  557:                             $s .= ", ";
  558:                         }
  559:                         $s .= $children[$i]->toMaxima();
  560:                     }
  561:                     $s .= ")";
  562:                     return($s);
  563:                 }
  564:             }
  565:         }
  566:         when (VECTOR) {
  567:             my @children = @{$self->children};
  568:             my $s;
  569:             if ($children[0]->type == VECTOR) {
  570:                 $s = "matrix(";
  571:             } else {
  572:                 $s = "[";
  573:             }
  574:             for (my $i=0; $i<scalar(@children); $i++) {
  575:                 if ($i != 0) {
  576:                     $s .= ", ";
  577:                 }
  578:                 $s .= $children[$i]->toMaxima();
  579:             }
  580:             if ($children[0]->type == VECTOR) {
  581:                 $s .= ")";
  582:             } else {
  583:                 $s .= "]";
  584:             }
  585:             return($s);
  586:         }
  587:         when (INTERVAL) {
  588:             die CalcException->new("Maxima syntax: intervals are not implemented.");
  589:             # see http://ieeexplore.ieee.org/xpls/icp.jsp?arnumber=5959544
  590:             # "New Package in Maxima for Single-Valued Interval Computation on Real Numbers"
  591:         }
  592:         when (SET) {
  593:             my @children = @{$self->children};
  594:             my $s = "{";
  595:             for (my $i=0; $i<scalar(@children); $i++) {
  596:                 if ($i != 0) {
  597:                     $s .= ", ";
  598:                 }
  599:                 $s .= $children[$i]->toMaxima();
  600:             }
  601:             $s .= "}";
  602:             return($s);
  603:         }
  604:         when (SUBSCRIPT) {
  605:             my @children = @{$self->children};
  606:             return("(".$children[0]->toMaxima()."_".$children[1]->toMaxima().")");
  607:         }
  608:     }
  609: }
  610: 
  611: ##
  612: # Returns the equation as a string with the TeX syntax.
  613: # @returns {string}
  614: ##
  615: sub toTeX {
  616:     my ( $self ) = @_;
  617:     
  618:     given ($self->type) {
  619:         when (UNKNOWN) {
  620:             die CalcException->new("Unknown node type: [_1].", $self->value);
  621:         }
  622:         when (NAME) {
  623:             my $name = $self->value;
  624:             if ($name =~ /^([a-zA-Z]+)([0-9]+)$/) {
  625:                 return($1."_{".$2."}");
  626:             }
  627:             my @greek = (
  628:                 "alpha", "beta", "gamma", "delta", "epsilon", "zeta",
  629:                 "eta", "theta", "iota", "kappa", "lambda", "mu",
  630:                 "nu", "xi", "omicron", "pi", "rho", "sigma",
  631:                 "tau", "upsilon", "phi", "chi", "psi", "omega",
  632:                 "Alpha", "Beta", "Gamma", "Delta", "Epsilon", "Zeta",
  633:                 "Eta", "Theta", "Iota", "Kappa", "Lambda", "Mu",
  634:                 "Nu", "Xi", "Omicron", "Pi", "Rho", "Sigma",
  635:                 "Tau", "Upsilon", "Phi", "Chi", "Psi", "Omega",
  636:             );
  637:             if ($name ~~ @greek) {
  638:                 return('\\'.$name);
  639:             } elsif ($name eq "hbar") {
  640:                 return("\\hbar");
  641:             } elsif ($name eq "inf") {
  642:                 return("\\infty");
  643:             } elsif ($name eq "minf") {
  644:                 return("-\\infty");
  645:             } else {
  646:                 return($name);
  647:             }
  648:         }
  649:         when (NUMBER) {
  650:             return $self->value;
  651:         }
  652:         when (OPERATOR) {
  653:             my @children = @{$self->children};
  654:             my $c0 = $children[0];
  655:             my $c1 = $children[1];
  656:             given ($self->value) {
  657:                 when ("+") {
  658:                     # should we add parenthesis ? We need to check if there is a '-' to the left of c1
  659:                     my $par = 0;
  660:                     my $first = $c1;
  661:                     while ($first->type == OPERATOR) {
  662:                         if ($first->value eq "-" && scalar(@{$first->children}) == 1) {
  663:                             $par = 1;
  664:                             last;
  665:                         } elsif ($first->value eq "+" || $first->value eq "-" || $first->value eq "*") {
  666:                             $first = $first->children->[0];
  667:                         } else {
  668:                             last;
  669:                         }
  670:                     }
  671:                     my $s = $c0->toTeX()." + ".$c1->toTeX();
  672:                     if ($par) {
  673:                         $s = "(".$s.")";
  674:                     }
  675:                     return $s;
  676:                 }
  677:                 when ("-") {
  678:                     if (!defined $c1) {
  679:                         return("-".$c0->toTeX());
  680:                     } else {
  681:                         my $s = $c0->toTeX()." - ";
  682:                         my $par = ($c1->type == OPERATOR &&
  683:                             ($c1->value eq "+" || $c1->value eq "-"));
  684:                         if ($par) {
  685:                             $s .= "(".$c1->toTeX().")";
  686:                         } else {
  687:                             $s .= $c1->toTeX();
  688:                         }
  689:                         return $s;
  690:                     }
  691:                 }
  692:                 when ("*") {
  693:                     my $par = ($c0->type == OPERATOR && ($c0->value eq "+" || $c0->value eq "-"));
  694:                     my $s = $c0->toTeX();
  695:                     if ($par) {
  696:                         $s = "(".$s.")";
  697:                     }
  698:                     # should the x operator be visible ? We need to check if there is a number to the left of c1
  699:                     my $firstinc1 = $c1;
  700:                     while ($firstinc1->type == OPERATOR) {
  701:                         $firstinc1 = $firstinc1->children->[0];
  702:                     }
  703:                     # ... and if it's an operation between vectors/matrices, the * operator should be displayed
  704:                     # (it is ambiguous otherwise)
  705:                     # note: this will not work if the matrix is calculated, for instance with 2[1;2]*[3;4]
  706:                     if ($c0->type == VECTOR && $c1->type == VECTOR) {
  707:                         $s .= " * ";
  708:                     } elsif ($firstinc1->type == NUMBER) {
  709:                         $s .= " \\times ";
  710:                     } else {
  711:                         $s .= " ";
  712:                     }
  713:                     $par = ($c1->type == OPERATOR && ($c1->value eq "+" || $c1->value eq "-"));
  714:                     if ($par) {
  715:                         $s .= "(".$c1->toTeX().")";
  716:                     } else {
  717:                         $s .= $c1->toTeX();
  718:                     }
  719:                     return $s;
  720:                 }
  721:                 when ("/") {
  722:                     # NOTE: cfrac would be better but tth does not handle it
  723:                     return("\\frac{".$c0->toTeX()."}{".$c1->toTeX()."}");
  724:                 }
  725:                 when ("^") {
  726:                     my $par;
  727:                     if ($c0->type == FUNCTION) {
  728:                         if ($c0->value eq "sqrt" || $c0->value eq "abs" || $c0->value eq "matrix" ||
  729:                                 $c0->value eq "diff") {
  730:                             $par = 0;
  731:                         } else {
  732:                             $par = 1;
  733:                         }
  734:                     } elsif ($c0->type == OPERATOR) {
  735:                         $par = 1;
  736:                     } else {
  737:                         $par = 0;
  738:                     }
  739:                     if ($par) {
  740:                         return("(".$c0->toTeX().")^{".$c1->toTeX()."}");
  741:                     } else {
  742:                         return($c0->toTeX()."^{".$c1->toTeX()."}");
  743:                     }
  744:                 }
  745:                 when ("!") {
  746:                     return($c0->toTeX()." !");
  747:                 }
  748:                 when ("%") {
  749:                     return($c0->toTeX()." \\% ".$c1->toTeX());
  750:                 }
  751:                 when (".") {
  752:                     # scalar product for vectors, multiplication for matrices
  753:                     my $par = ($c0->type == OPERATOR && ($c0->value eq "+" || $c0->value eq "-"));
  754:                     my $s = $c0->toTeX();
  755:                     if ($par) {
  756:                         $s = "(".$s.")";
  757:                     }
  758:                     $s .= " \\cdot ";
  759:                     $par = ($c1->type == OPERATOR && ($c1->value eq "+" || $c1->value eq "-"));
  760:                     if ($par) {
  761:                         $s .= "(".$c1->toTeX().")";
  762:                     } else {
  763:                         $s .= $c1->toTeX();
  764:                     }
  765:                     return $s;
  766:                 }
  767:                 when ("`") {
  768:                     return($c0->toTeX()." \\mathrm{".$c1->toTeX()."}");
  769:                 }
  770:                 when ("=") {
  771:                     return($c0->toTeX()." = ".$c1->toTeX());
  772:                 }
  773:                 when ("#") {
  774:                     return($c0->toTeX()." \\not ".$c1->toTeX());
  775:                 }
  776:                 when ("<") {
  777:                     return($c0->toTeX()." < ".$c1->toTeX());
  778:                 }
  779:                 when (">") {
  780:                     return($c0->toTeX()." > ".$c1->toTeX());
  781:                 }
  782:                 when ("<=") {
  783:                     return($c0->toTeX()." \\leq ".$c1->toTeX());
  784:                 }
  785:                 when (">=") {
  786:                     return($c0->toTeX()." \\geq ".$c1->toTeX());
  787:                 }
  788:                 default {
  789:                     die CalcException->new("Unknown operator: [_1].", $self->value);
  790:                 }
  791:             }
  792:         }
  793:         when (FUNCTION) {
  794:             my @children = @{$self->children};
  795:             my $fname = $children[0]->value;
  796:             my $c1 = $children[1];
  797:             my $c2 = $children[2];
  798:             my $c3 = $children[3];
  799:             my $c4 = $children[4];
  800:             
  801:             given ($fname) {
  802:                 when ("sqrt") {   return "\\sqrt{".$c1->toTeX()."}"; }
  803:                 when ("abs") {    return "|".$c1->toTeX()."|"; }
  804:                 when ("exp") {    return "\\mathrm{e}^{".$c1->toTeX()."}"; }
  805:                 when ("diff") {
  806:                     if (scalar(@children) == 3) {
  807:                         return "\\frac{d}{d".$c2->toTeX()."} ".$c1->toTeX();
  808:                     } else {
  809:                         return "\\frac{d^{".$c3->toTeX()."}}{d ".$c2->toTeX().
  810:                             "^{".$c3->toTeX()."}} ".$c1->toTeX();
  811:                     }
  812:                 }
  813:                 when ("integrate") {
  814:                     if (scalar(@children) == 3) {
  815:                         return "\\int ".$c1->toTeX()." \\ d ".$c2->toTeX();
  816:                     } else {
  817:                         return "\\int_{".$c3->toTeX()."}^{".$c4->toTeX()."} ".
  818:                             $c1->toTeX()." \\ d ".$c2->toTeX();
  819:                     }
  820:                 }
  821:                 when ("sum") {
  822:                     return "\\sum_{".$c2->toTeX()."=".$c3->toTeX().
  823:                         "}^{".$c4->toTeX()."} ".$c1->toTeX();
  824:                 }
  825:                 when ("product") {
  826:                     return "\\prod_{".$c2->toTeX()."=".$c3->toTeX().
  827:                         "}^{".$c4->toTeX()."} ".$c1->toTeX();
  828:                 }
  829:                 when ("limit") {
  830:                     if (scalar(@children) < 4) {
  831:                         return "\\lim ".$c1->toTeX();
  832:                     } elsif (scalar(@children) == 4) {
  833:                         return "\\lim_{".$c2->toTeX()." \\to ".$c3->toTeX().
  834:                         "}".$c1->toTeX();
  835:                     } else {
  836:                         return "\\lim_{".$c2->toTeX()." \\to ".$c3->toTeX().
  837:                         (($c4->value eq "plus") ? "+" : "-").
  838:                         "}".$c1->toTeX();
  839:                     }
  840:                 }
  841:                 when ("binomial") {
  842:                     return "\\binom{".$c1->toTeX()."}{".$c2->toTeX()."}";
  843:                 }
  844:                 when (["union","intersection"]) {
  845:                     if (!defined $children[2]) {
  846:                         die CalcException->new("Missing parameter for function [_1].", $fname);
  847:                     }
  848:                     if ($c1->type != SET && $c1->type != INTERVAL && $c1->type != FUNCTION) {
  849:                         die CalcException->new("Wrong type for function [_1] (should be a set or interval).", $fname);
  850:                     }
  851:                     if ($fname eq "union") {
  852:                         return $c1->toTeX().' \cup '.$c2->toTeX();
  853:                     } else {
  854:                         return $c1->toTeX().' \cap '.$c2->toTeX();
  855:                     }
  856:                 }
  857:                 when ("sin") {     return "\\sin ".$c1->toTeX(); }
  858:                 when ("cos") {     return "\\cos ".$c1->toTeX(); }
  859:                 when ("tan") {     return "\\tan ".$c1->toTeX(); }
  860:                 when ("asin") {    return "\\arcsin ".$c1->toTeX(); }
  861:                 when ("acos") {    return "\\arccos ".$c1->toTeX(); }
  862:                 when ("atan") {    return "\\arctan ".$c1->toTeX(); }
  863:                 when ("sinh") {    return "\\sinh ".$c1->toTeX(); }
  864:                 when ("cosh") {    return "\\cosh ".$c1->toTeX(); }
  865:                 when ("tanh") {    return "\\tanh ".$c1->toTeX(); }
  866:                 default {
  867:                     my $s = $fname."(";
  868:                     for (my $i=1; $i<scalar(@children); $i++) {
  869:                         if ($i != 1) {
  870:                             $s .= ", ";
  871:                         }
  872:                         $s .= $children[$i]->toTeX();
  873:                     }
  874:                     $s .= ")";
  875:                     return($s);
  876:                 }
  877:             }
  878:         }
  879:         when (VECTOR) {
  880:             my @children = @{$self->children};
  881:             # my $s = "\\begin{pmatrix}";
  882:             # NOTE: pmatrix would be easier, but tth does not recognize it
  883:             my $col;
  884:             if (scalar(@children) == 0) {
  885:                 $col = 0;
  886:             } elsif ($children[0]->type == VECTOR) {
  887:                 $col = scalar(@{$children[0]->children});
  888:             } else {
  889:                 $col = 1;
  890:             }
  891:             my $s = "\\left( \\begin{array}{".('c' x $col)."}";
  892:             for (my $i=0; $i<scalar(@children); $i++) {
  893:                 if ($i != 0) {
  894:                     $s .= " \\\\ ";
  895:                 }
  896:                 if ($children[0]->type == VECTOR) {
  897:                     # matrix
  898:                     for (my $j=0; $j<scalar(@{$children[$i]->children}); $j++) {
  899:                         if ($j != 0) {
  900:                             $s .= " & ";
  901:                         }
  902:                         $s .= $children[$i]->children->[$j]->toTeX();
  903:                     }
  904:                 } else {
  905:                     # vector
  906:                     $s .= $children[$i]->toTeX();
  907:                 }
  908:             }
  909:             # $s .= "\\end{pmatrix}";
  910:             $s .= "\\end{array} \\right)";
  911:             return($s);
  912:         }
  913:         when (INTERVAL) {
  914:             my @children = @{$self->children};
  915:             if (scalar(@children) != 2) {
  916:                 die CalcException->new("Interval should have two parameters.");
  917:             }
  918:             my ($qminopen, $qmaxopen);
  919:             given ($self->interval_type) {
  920:                 when (OPEN_OPEN) { $qminopen = 1; $qmaxopen = 1; }
  921:                 when (OPEN_CLOSED) { $qminopen = 1; $qmaxopen = 0; }
  922:                 when (CLOSED_OPEN) { $qminopen = 0; $qmaxopen = 1; }
  923:                 when (CLOSED_CLOSED) { $qminopen = 0; $qmaxopen = 0; }
  924:             }
  925:             my $s = "\\left";
  926:             if ($qminopen) {
  927:                 $s .= "(";
  928:             } else {
  929:                 $s .= "[";
  930:             }
  931:             $s .= $children[0]->toTeX();
  932:             $s .= ", ";
  933:             $s .= $children[1]->toTeX();
  934:             $s .= "\\right";
  935:             if ($qmaxopen) {
  936:                 $s .= ")";
  937:             } else {
  938:                 $s .= "]";
  939:             }
  940:             return($s);
  941:         }
  942:         when (SET) {
  943:             my @children = @{$self->children};
  944:             my $s = "\\left\\{ {";
  945:             for (my $i=0; $i<scalar(@children); $i++) {
  946:                 if ($i != 0) {
  947:                     $s .= ", ";
  948:                 }
  949:                 $s .= $children[$i]->toTeX();
  950:             }
  951:             $s .= "}\\right\\}";
  952:             return($s);
  953:         }
  954:         when (SUBSCRIPT) {
  955:             my @children = @{$self->children};
  956:             return($children[0]->toTeX()."_{".$children[1]->toTeX()."}");
  957:         }
  958:     }
  959: }
  960: ##
  961: # Creates a vector or a matrix with this node
  962: # @param {CalcEnv} env - Calculation environment.
  963: # @returns {QVector|QMatrix}
  964: ##
  965: sub createVectorOrMatrix {
  966:     my ( $self, $env ) = @_;
  967:     my @children = @{$self->children};
  968:     my @t = (); # 1d or 2d array of Quantity
  969:     my $start;
  970:     if ($self->type == FUNCTION) {
  971:         $start = 1;
  972:     } else {
  973:         $start = 0;
  974:     }
  975:     my $nb1;
  976:     for (my $i=0; $i < scalar(@children) - $start; $i++) {
  977:         my $qv = $children[$i+$start]->calc($env);
  978:         my $nb2;
  979:         if ($qv->isa(Quantity)) {
  980:             $nb2 = 1;
  981:         } else {
  982:             $nb2 = scalar(@{$qv->quantities});
  983:         }
  984:         if (!defined $nb1) {
  985:             $nb1 = $nb2;
  986:         } elsif ($nb2 != $nb1) {
  987:             die CalcException->new("Inconsistent number of elements in a matrix.");
  988:         }
  989:         if ($qv->isa(Quantity)) {
  990:             $t[$i] = $qv;
  991:         } else {
  992:             $t[$i] = [];
  993:             for (my $j=0; $j < scalar(@{$qv->quantities}); $j++) {
  994:                 $t[$i][$j] = $qv->quantities->[$j];
  995:             }
  996:         }
  997:     }
  998:     if (ref($t[0]) eq 'ARRAY') {
  999:         return QMatrix->new(\@t);
 1000:     } else {
 1001:         return QVector->new(\@t);
 1002:     }
 1003: }
 1004: 
 1005: 1;
 1006: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>