File:  [LON-CAPA] / loncom / homework / math_parser / ENode.pm
Revision 1.6: download - view: text, annotated - select for diffs
Mon Mar 13 22:31:22 2023 UTC (14 months, 3 weeks ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, version_2_11_4_msu, HEAD
- Add $Id$ line in comments for display of version.

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

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