Annotation of loncom/homework/math_parser/Parser.pm, revision 1.2

1.1       damieng     1: # The LearningOnline Network with CAPA - LON-CAPA
                      2: # Parser
                      3: #
                      4: # Copyright (C) 2014 Michigan State University Board of Trustees
                      5: #
                      6: # This program is free software: you can redistribute it and/or modify
                      7: # it under the terms of the GNU General Public License as published by
                      8: # the Free Software Foundation, either version 3 of the License, or
                      9: # (at your option) any later version.
                     10: #
                     11: # This program is distributed in the hope that it will be useful,
                     12: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     13: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
                     14: # GNU General Public License for more details.
                     15: #
                     16: # You should have received a copy of the GNU General Public License
                     17: # along with this program. If not, see <http://www.gnu.org/licenses/>.
                     18: #
                     19: 
                     20: ##
                     21: # Equation parser
                     22: ##
                     23: package Apache::math_parser::Parser;
                     24: 
                     25: use strict;
                     26: use warnings;
                     27: use utf8;
                     28: 
                     29: use aliased 'Apache::math_parser::Definitions';
                     30: use aliased 'Apache::math_parser::ENode';
                     31: use aliased 'Apache::math_parser::Operator';
                     32: use aliased 'Apache::math_parser::ParseException';
                     33: use aliased 'Apache::math_parser::Token';
                     34: use aliased 'Apache::math_parser::Tokenizer';
                     35: 
                     36: ##
                     37: # Constructor
                     38: # @optional {boolean} implicit_operators - assume hidden multiplication and unit operators in some cases (unlike maxima)
                     39: # @optional {boolean} unit_mode - handle only numerical expressions with units (no variable)
                     40: ##
                     41: sub new {
1.2     ! damieng    42:     my ($class, $implicit_operators, $unit_mode) = @_;
        !            43:     if (!defined $implicit_operators) {
        !            44:         $implicit_operators = 0;
        !            45:     }
        !            46:     if (!defined $unit_mode) {
        !            47:         $unit_mode = 0;
        !            48:     }
1.1       damieng    49:     my $self = {
1.2     ! damieng    50:         _implicit_operators => $implicit_operators,
        !            51:         _unit_mode => $unit_mode,
1.1       damieng    52:         _defs => Definitions->new(),
                     53:     };
                     54:     $self->{_defs}->define();
                     55:     bless $self, $class;
                     56:     return $self;
                     57: }
                     58: 
                     59: # Attribute helpers
                     60: 
                     61: ##
                     62: # Implicit operators ?
                     63: # @returns {boolean}
                     64: ##
                     65: sub implicit_operators {
                     66:     my $self = shift;
                     67:     return $self->{_implicit_operators};
                     68: }
                     69: 
                     70: ##
                     71: # Unit mode ?
                     72: # @returns {boolean}
                     73: ##
                     74: sub unit_mode {
                     75:     my $self = shift;
                     76:     return $self->{_unit_mode};
                     77: }
                     78: 
                     79: ##
                     80: # Definitions
                     81: # @returns {Definitions}
                     82: ##
                     83: sub defs {
                     84:     my $self = shift;
                     85:     return $self->{_defs};
                     86: }
                     87: 
                     88: ##
                     89: # Tokens
                     90: # @returns {Token[]}
                     91: ##
                     92: sub tokens {
                     93:     my $self = shift;
                     94:     return $self->{_tokens};
                     95: }
                     96: 
                     97: ##
                     98: # Current token
                     99: # @returns {Token}
                    100: ##
                    101: sub current_token {
                    102:     my $self = shift;
                    103:     return $self->{_current_token};
                    104: }
                    105: 
                    106: ##
                    107: # Current token number
                    108: # @returns {int}
                    109: ##
                    110: sub token_nr {
                    111:     my $self = shift;
                    112:     return $self->{_token_nr};
                    113: }
                    114: 
                    115: 
                    116: ##
                    117: # Returns the right node at the current token, based on top-down operator precedence.
                    118: # @param {integer} rbp - Right binding power
                    119: # @returns {ENode}
                    120: ##
                    121: sub expression {
                    122:     my( $self, $rbp ) = @_;
                    123:     my $left; # ENode
                    124:     my $t = $self->current_token;
                    125:     if (! defined $t) {
                    126:         die ParseException->new("Expected something at the end.",
                    127:             $self->tokens->[scalar(@{$self->tokens}) - 1]->to + 1);
                    128:     }
                    129:     $self->advance();
                    130:     if (! defined $t->op) {
                    131:         $left = ENode->new($t->type, undef, $t->value, undef);
                    132:     } elsif (! defined $t->op->nud) {
                    133:         die ParseException->new("Unexpected operator '[_1]'.", $t->from, $t->from, $t->op->id);
                    134:     } else {
                    135:         $left = $t->op->nud->($t->op, $self);
                    136:     }
                    137:     while (defined $self->current_token && defined $self->current_token->op &&
                    138:             $rbp < $self->current_token->op->lbp) {
                    139:         $t = $self->current_token;
                    140:         $self->advance();
                    141:         $left = $t->op->led->($t->op, $self, $left);
                    142:     }
                    143:     return $left;
                    144: }
                    145: 
                    146: ##
                    147: # Advance to the next token,
                    148: # expecting the given operator id if it is provided.
                    149: # Throws a ParseException if a given operator id is not found.
                    150: # @optional {string} id - Operator id
                    151: ##
                    152: sub advance {
                    153:     my ( $self, $id ) = @_;
                    154:     if (defined $id && (!defined $self->current_token || !defined $self->current_token->op ||
                    155:             $self->current_token->op->id ne $id)) {
                    156:         if (!defined $self->current_token) {
                    157:             die ParseException->new("Expected '[_1]' at the end.",
                    158:                 $self->tokens->[scalar(@{$self->tokens}) - 1]->to + 1, undef, $id);
                    159:         } else {
                    160:             die ParseException->new("Expected '[_1]'.", $self->current_token->from, undef, $id);
                    161:         }
                    162:     }
                    163:     if ($self->token_nr >= scalar(@{$self->tokens})) {
                    164:         $self->{_current_token} = undef;
                    165:         return;
                    166:     }
                    167:     $self->{_current_token} = $self->tokens->[$self->token_nr];
                    168:     $self->{_token_nr} += 1;
                    169: }
                    170: 
                    171: 
                    172: ##
                    173: # Adds hidden multiplication and unit operators to the token stream
                    174: ##
                    175: sub addHiddenOperators {
                    176:     my ( $self ) = @_;
                    177:     my $multiplication = $self->defs->findOperator("*");
                    178:     my $unit_operator = $self->defs->findOperator("`");
                    179:     my $in_units = 0; # we check if we are already in the units to avoid adding two ` operators inside
                    180:     my $in_exp = 0;
                    181:     for (my $i=0; $i<scalar(@{$self->tokens}) - 1; $i++) {
                    182:         my $token = $self->tokens->[$i];
                    183:         my $next_token = $self->tokens->[$i + 1];
                    184:         if ($self->unit_mode) {
                    185:             if ($token->value eq "`") {
                    186:                 $in_units = 1;
                    187:             } elsif ($in_units) {
                    188:                 if ($token->value eq "^") {
                    189:                     $in_exp = 1;
                    190:                 } elsif ($in_exp && $token->type == Token->NUMBER) {
                    191:                     $in_exp = 0;
                    192:                 } elsif (!$in_exp && $token->type == Token->NUMBER) {
                    193:                     $in_units = 0;
                    194:                 } elsif (!$in_exp && $token->type == Token->OPERATOR && index("*/^()", $token->value) == -1) {
                    195:                     $in_units = 0;
                    196:                 } elsif ($token->type == Token->NAME && $next_token->value eq "(") {
                    197:                     $in_units = 0;
                    198:                 }
                    199:             }
                    200:         }
                    201:         my $token_type = $token->type;
                    202:         my $next_token_type = $next_token->type;
                    203:         my $token_value = $token->value;
                    204:         my $next_token_value = $next_token->value;
                    205:         if (
                    206:                 ($token_type == Token->NAME && $next_token_type == Token->NAME) ||
                    207:                 ($token_type == Token->NUMBER && $next_token_type == Token->NAME) ||
                    208:                 ($token_type == Token->NUMBER && $next_token_type == Token->NUMBER) ||
1.2     ! damieng   209:                 ($token_type == Token->NUMBER && string_in_array(["(","[","{"], $next_token_value)) ||
1.1       damieng   210:                 # ($token_type == Token->NAME && $next_token_value eq "(") ||
                    211:                 # name ( could be a function call
1.2     ! damieng   212:                 (string_in_array([")","]","}"], $token_value) && $next_token_type == Token->NAME) ||
        !           213:                 (string_in_array([")","]","}"], $token_value) && $next_token_type == Token->NUMBER) ||
        !           214:                 (string_in_array([")","]","}"], $token_value) && $next_token_value eq "(")
1.1       damieng   215:            ) {
                    216:             # support for things like "(1/2) (m/s)" is complex...
                    217:             my $units = ($self->unit_mode && !$in_units &&
1.2     ! damieng   218:                 ($token_type == Token->NUMBER || string_in_array([")","]","}"], $token_value)) &&
1.1       damieng   219:                 ($next_token_type == Token->NAME ||
1.2     ! damieng   220:                     (string_in_array(["(","[","{"], $next_token_value) && scalar(@{$self->tokens}) > $i + 2 &&
1.1       damieng   221:                     $self->tokens->[$i + 2]->type == Token->NAME)));
                    222:             if ($units) {
                    223:                 my( $test_token, $index_test);
                    224:                 if ($next_token_type == Token->NAME) {
                    225:                     $test_token = $next_token;
                    226:                     $index_test = $i + 1;
                    227:                 } else {
                    228:                     # for instance for "2 (m/s)"
                    229:                     $index_test = $i + 2;
                    230:                     $test_token = $self->tokens->[$index_test];
                    231:                 }
                    232:                 if (scalar(@{$self->tokens}) > $index_test + 1 && $self->tokens->[$index_test + 1]->value eq "(") {
                    233:                     my @known_functions = ("pow", "sqrt", "abs", "exp", "factorial", "diff",
                    234:                         "integrate", "sum", "product", "limit", "binomial", "matrix",
                    235:                         "ln", "log", "log10", "mod", "sgn", "ceil", "floor",
                    236:                         "sin", "cos", "tan", "asin", "acos", "atan", "atan2",
                    237:                         "sinh", "cosh", "tanh", "asinh", "acosh", "atanh");
                    238:                     for (my $j=0; $j<scalar(@known_functions); $j++) {
                    239:                         if ($test_token->value eq $known_functions[$j]) {
                    240:                             $units = 0;
                    241:                             last;
                    242:                         }
                    243:                     }
                    244:                 }
                    245:             }
                    246:             my $new_token;
                    247:             if ($units) {
                    248:                 $new_token = Token->new(Token->OPERATOR, $next_token->from,
                    249:                     $next_token->from, $unit_operator->id, $unit_operator);
                    250:             } else {
                    251:                 $new_token = Token->new(Token->OPERATOR, $next_token->from,
                    252:                     $next_token->from, $multiplication->id, $multiplication);
                    253:             }
                    254:             splice(@{$self->{_tokens}}, $i+1, 0, $new_token);
                    255:         }
                    256:     }
                    257: }
                    258: 
                    259: ##
                    260: # Parse the string, returning an ENode tree.
                    261: # @param {string} text - The text to parse.
                    262: # @returns {ENode}
                    263: ##
                    264: sub parse {
                    265:     my ( $self, $text ) = @_;
                    266:     
                    267:     my $tokenizer = Tokenizer->new($self->defs, $text);
                    268:     @{$self->{_tokens}} = $tokenizer->tokenize();
                    269:     if (scalar(@{$self->tokens}) == 0) {
                    270:         die ParseException->new("No information found.");
                    271:     }
                    272:     if ($self->implicit_operators) {
                    273:         $self->addHiddenOperators();
                    274:     }
                    275:     $self->{_token_nr} = 0;
                    276:     $self->{_current_token} = $self->tokens->[$self->token_nr];
                    277:     $self->advance();
                    278:     my $root = $self->expression(0);
                    279:     if (defined $self->current_token) {
                    280:         die ParseException->new("Expected the end.", $self->current_token->from);
                    281:     }
                    282:     return $root;
                    283: }
                    284: 
1.2     ! damieng   285: ##
        !           286: # Tests if a string is in an array (using eq) (to avoid using $value ~~ @array)
        !           287: # @param {Array<string>} array - reference to the array of strings
        !           288: # @param {string} value - the string to look for
        !           289: # @returns 1 if found, 0 otherwise
        !           290: ##
        !           291: sub string_in_array {
        !           292:   my ($array, $value) = @_;
        !           293:   foreach my $v (@{$array}) {
        !           294:     if ($v eq $value) {
        !           295:       return 1;
        !           296:     }
        !           297:   }
        !           298:   return 0;
        !           299: }
        !           300: 
1.1       damieng   301: 1;
                    302: __END__

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