Annotation of loncom/homework/math_parser/ENode.pm, revision 1.6

1.1       damieng     1: # The LearningOnline Network with CAPA - LON-CAPA
                      2: # Parsed tree node
                      3: #
1.6     ! raeburn     4: # $Id: ENode.pm,v 1.6 2023/03/13 18:30:00 raeburn Exp $
        !             5: #
1.1       damieng     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: 
1.2       damieng    31: use Switch 'Perl6';
1.1       damieng    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 {
1.3       damieng    55:     my ($class, $type, $op, $value, $children, $interval_type) = @_;
                     56:     if (!defined $interval_type) {
                     57:         $interval_type = NOT_AN_INTERVAL;
                     58:     }
1.1       damieng    59:     my $self = {
1.3       damieng    60:         _type => $type,
                     61:         _op => $op,
                     62:         _value => $value,
                     63:         _children => $children,
                     64:         _interval_type => $interval_type,
1.1       damieng    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);
1.3       damieng   315:             if (string_in_array(['pow', 'sqrt', 'abs', 'exp', 'ln', 'log', 'log10', 'factorial',
1.1       damieng   316:                     'mod', 'sgn', 'ceil', 'floor', 'sin', 'cos', 'tan', 'asin', 'acos', 'atan',
1.3       damieng   317:                     'atan2', 'sinh', 'cosh', 'tanh', 'asinh', 'acosh', 'atanh'], $fname)) {
1.1       damieng   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:             }
1.3       damieng   323:             if (string_in_array(['pow', 'mod', 'atan2'], $fname)) {
1.1       damieng   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:             );
1.3       damieng   642:             if (string_in_array(\@greek, $name)) {
1.1       damieng   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 ("!") {
1.5       damieng   751:                     my $s = $c0->toTeX();
                    752:                     if ($c0->type == OPERATOR) {
                    753:                         $s = "(".$s.")";
                    754:                     }
                    755:                     $s .= " !";
                    756:                     return $s;
1.1       damieng   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()."}"; }
1.5       damieng   815:                 when ("factorial") {
                    816:                     my $s = $c1->toTeX();
                    817:                     if ($c1->type == OPERATOR) {
                    818:                         $s = "(".$s.")";
                    819:                     }
                    820:                     $s .= " !";
                    821:                     return $s;
                    822:                 }
1.1       damieng   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 {
1.4       damieng   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;
1.1       damieng   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: 
1.3       damieng  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: 
1.1       damieng  1044: 1;
                   1045: __END__

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