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>