Annotation of loncom/xml/algebra/AlgParser.pm, revision 1.4
1.1 albertel 1:
2:
3: ## Last modification: 8/3/00 by akp
4: ## Originally written by Daniel Martin, Dept of Math, John Hopkins
5: ## Additions and modifications were made by James Martino, Dept of Math, John Hopkins
6: ## Additions and modifications were made by Arnold Pizer, Dept of Math, Univ of Rochester
7:
8: #use Data::Dumper;
1.2 albertel 9: use strict;
1.1 albertel 10:
11: package AlgParser;
12: use HTML::Entities;
13:
1.2 albertel 14: my %close = ();
1.1 albertel 15:
16: sub new {
17: my $package = shift;
18: my (%ret);
19: $ret{string} = "";
20: $ret{posarray} = [];
21: $ret{parseerror} = "";
22: $ret{parseresult} = [];
23: bless \%ret, $package;
24: return \%ret;
25: }
26:
27: sub inittokenizer {
28: my($self, $string) = @_;
29: $self->{string} =~ m/\G.*$/g;
30: $self->{string} = undef;
31: $self->{string} = $string;
32: $self->{string} =~ m/\G.*$/g;
33: $self->{string} =~ m/^/g;
34: }
35:
36: $close{'{'} = '}';
37: $close{'['} = ']';
38: $close{'('} = ')';
39:
1.2 albertel 40: my $binoper3 = '(?:\\^|\\*\\*)';
41: my $binoper2 = '[/*_,]';
42: my $binoper1 = '[-+=><%!#]';
43: my $openparen = '[{(\\[]';
44: my $closeparen = '[})\\]]';
45: my $varname = '[A-Za-z](?:_[0-9]+)?';
1.3 albertel 46: my $greek='alpha|bita|gamma|zita|thita|iota|kappa|lambda|mu|nu|xi|rho|sigma|tau|phi|chi|psi|omega|zepslon|zdelta|xeta|zupslon';
47: my $delete='zeroplace';
48: my $escape='infty';
1.4 ! albertel 49: my $specialvalue = '(?:e|pi|d[a-z]|'.$escape.'|'.$greek.'|'.$delete.')';
1.2 albertel 50: my $numberplain = '(?:\d+(?:\.\d*)?|\.\d+)';
51: my $numberE = '(?:' . $numberplain . 'E[-+]?\d+)';
52: my $number = '(?:' . $numberE . '|' . $numberplain . ')';
1.1 albertel 53: #
54: # DPVC -- 2003/03/31
55: # added missing trig and inverse functions
56: #
57: #$trigfname = '(?:cosh|sinh|tanh|cot|(?:a(?:rc)?)?cos|(?:a(?:rc)?)?sin|' .
58: # '(?:a(?:rc)?)?tan|sech?)';
1.2 albertel 59: my $trigfname = '(?:(?:a(?:rc)?)?(?:sin|cos|tan|sec|csc|cot)h?)';
1.1 albertel 60: #
61: # End DPVC
62: #
1.2 albertel 63: my $otherfunc = '(?:exp|abs|logten|log|ln|sqrt|sgn|step|fact|int|lim|fun[a-zA-Z])';
64: my $funcname = '(?:' . $otherfunc . '|' . $trigfname . ')';
1.1 albertel 65:
1.2 albertel 66: my $tokenregexp = "(?:($binoper3)|($binoper2)|($binoper1)|($openparen)|" .
1.1 albertel 67: "($closeparen)|($funcname)|($specialvalue)|($varname)|" .
68: "($numberE)|($number))";
69:
70: sub nexttoken {
71: my($self) = shift;
72: $self->{string} =~ m/\G\s+/gc;
73: my($p1) = pos($self->{string}) || 0;
74: if(scalar($self->{string} =~ m/\G$tokenregexp/gc)) {
75: push @{$self->{posarray}}, [$p1, pos($self->{string})];
76: if (defined($1)) {return ['binop3', $1];}
77: if (defined($2)) {return ['binop2', $2];}
78: if (defined($3)) {return ['binop1', $3];}
79: if (defined($4)) {return ['openp', $4];}
80: if (defined($5)) {return ['closep', $5];}
81: if (defined($6)) {return ['func1', $6];}
82: if (defined($7)) {return ['special', $7];}
83: if (defined($8)) {return ['varname', $8];}
84: if (defined($9)) {return ['numberE', $9];}
85: if (defined($10)) {return ['number', $10];}
86: }
87: else {
88: push @{$self->{posarray}}, [$p1, undef];
89: return undef;
90: }
91: }
92:
93: sub parse {
94: my $self = shift;
95: $self->{parseerror} = "";
96: $self->{posarray} = [];
97: $self->{parseresult} = ['top', undef];
98: my (@backtrace) = (\$self->{parseresult});
99: my (@pushback) = ();
100:
101: my $currentref = \$self->{parseresult}->[1];
1.2 albertel 102: my $currenttok;
1.1 albertel 103:
104: my $sstring = shift;
105: $self->inittokenizer($sstring);
106: $currenttok = $self->nexttoken;
107: if (!$currenttok) {
108: if ($self->{string} =~ m/\G$/g) {
109: return $self->error("empty");
110: } else {
111: my($mark) = pop @{$self->{posarray}};
112: my $position = 1+$mark->[0];
113: return $self->error("Illegal character at position $position", $mark);
114: }
115: }
116: # so I can assume we got a token
117: local $_;
118: while ($currenttok) {
119: $_ = $currenttok->[0];
120: /binop1/ && do {
121: # check if we have a binary or unary operation here.
122: if (defined(${$currentref})) {
123: # binary - walk up the tree until we hit an open paren or the top
124: while (${$currentref}->[0] !~ /^(openp|top)/) {
125: $currentref = pop @backtrace;
126: }
127: my $index = ((${$currentref}->[0] eq 'top')?1:3);
128: ${$currentref}->[$index] = ['binop1', $currenttok->[1],
129: ${$currentref}->[$index], undef];
130: push @backtrace, $currentref;
131: push @backtrace, \${$currentref}->[$index];
132: $currentref = \${$currentref}->[$index]->[3];
133: } else {
134: # unary
135: ${$currentref} = ['unop1', $currenttok->[1], undef];
136: push @backtrace, $currentref;
137: $currentref = \${$currentref}->[2];
138: }
139: };
140: /binop2/ && do {
141: if (defined(${$currentref})) {
142: # walk up the tree until an open paren, the top, binop1 or unop1
143: # I decide arbitrarily that -3*4 should be parsed as -(3*4)
144: # instead of as (-3)*4. Not that it makes a difference.
145:
146: while (${$currentref}->[0] !~ /^(openp|top|binop1)/) {
147: $currentref = pop @backtrace;
148: }
149: my $a = ${$currentref}->[0];
150: my $index = (($a eq 'top')?1:3);
151: ${$currentref}->[$index] = ['binop2', $currenttok->[1],
152: ${$currentref}->[$index], undef];
153: push @backtrace, $currentref;
154: push @backtrace, \${$currentref}->[$index];
155: $currentref = \${$currentref}->[$index]->[3];
156: } else {
157: # Error
158: my($mark) = pop @{$self->{posarray}};
159: my $position =1+$mark->[0];
160: return $self->error("Didn't expect " . $currenttok->[1] .
161: " at position $position" , $mark);
162: }
163: };
164: /binop3/ && do {
165: if (defined(${$currentref})) {
166: # walk up the tree until we need to stop
167: # Note that the right-associated nature of ^ means we need to
168: # stop walking backwards when we hit a ^ as well.
169: while (${$currentref}->[0] !~ /^(openp|top|binop[123]|unop1)/) {
170: $currentref = pop @backtrace;
171: }
172: my $a = ${$currentref}->[0];
173: my $index = ($a eq 'top')?1:($a eq 'unop1')?2:3;
174: ${$currentref}->[$index] = ['binop3', $currenttok->[1],
175: ${$currentref}->[$index], undef];
176: push @backtrace, $currentref;
177: push @backtrace, \${$currentref}->[$index];
178: $currentref = \${$currentref}->[$index]->[3];
179: } else {
180: # Error
181: my($mark) = pop @{$self->{posarray}};
182: my $position = 1+$mark->[0];
183: return $self->error("Didn't expect " . $currenttok->[1] .
184: " at position $position", $mark);
185: }
186: };
187: /openp/ && do {
188: if (defined(${$currentref})) {
189: # we weren't expecting this - must be implicit
190: # multiplication.
191: push @pushback, $currenttok;
192: $currenttok = ['binop2', 'implicit'];
193: next;
194: } else {
195: my($me) = pop @{$self->{posarray}};
196: ${$currentref} = [$currenttok->[0], $currenttok->[1], $me, undef];
197: push @backtrace, $currentref;
198: $currentref = \${$currentref}->[3];
199: }
200: };
201: /func1/ && do {
202: if (defined(${$currentref})) {
203: # we weren't expecting this - must be implicit
204: # multiplication.
205: push @pushback, $currenttok;
206: $currenttok = ['binop2', 'implicit'];
207: next;
208: } else {
209: # just like a unary operator
210: ${$currentref} = [$currenttok->[0], $currenttok->[1], undef];
211: push @backtrace, $currentref;
212: $currentref = \${$currentref}->[2];
213: }
214: };
215: /closep/ && do {
216: if (defined(${$currentref})) {
217: # walk up the tree until we need to stop
218: while (${$currentref}->[0] !~ /^(openp|top)/) {
219: $currentref = pop @backtrace;
220: }
221: my $a = ${$currentref}->[0];
222: if ($a eq 'top') {
223: my($mark) = pop @{$self->{posarray}};
224: my $position = 1+$mark->[0];
225: return $self->error("Unmatched close " . $currenttok->[1] .
226: " at position $position", $mark);
227: } elsif ($close{${$currentref}->[1]} ne $currenttok->[1]) {
228: my($mark) = pop @{$self->{posarray}};
229: my $position = 1+$mark->[0];
230: return $self->error("Mismatched parens at position $position"
231: , ${$currentref}->[2], $mark);
232: } else {
233: ${$currentref}->[0] = 'closep';
234: ${$currentref}->[2] = pop @{${$currentref}};
235: }
236: } else {
237: # Error - something like (3+4*)
238: my($mark) = pop @{$self->{posarray}};
239: my $position = 1+$mark->[0];
240: return $self->error("Premature close " . $currenttok->[1] .
241: " at position $position", $mark);
242: }
243: };
244: /special|varname|numberE?/ && do {
245: if (defined(${$currentref})) {
246: # we weren't expecting this - must be implicit
247: # multiplication.
248: push @pushback, $currenttok;
249: $currenttok = ['binop2', 'implicit'];
250: next;
251: } else {
252: ${$currentref} = [$currenttok->[0], $currenttok->[1]];
253: }
254: };
255: if (@pushback) {
256: $currenttok = pop @pushback;
257: } else {
258: $currenttok = $self->nexttoken;
259: }
260: }
261: # ok, we stopped parsing. Now we need to see why.
262: if ($self->{parseresult}->[0] eq 'top') {
263: $self->{parseresult} = $self->arraytoexpr($self->{parseresult}->[1]);
264: } else {
265: return $self->error("Internal consistency error; not at top when done");
266: }
267: if ($self->{string} =~ m/\G\s*$/g) {
268: if (!defined(${$currentref})) {
269: $self->{string} .= " ";
270: return $self->error("I was expecting more at the end of the line",
271: [length($self->{string})-1, length($self->{string})]);
272: } else {
273: # check that all the parens were closed
274: while (@backtrace) {
275: $currentref = pop @backtrace;
276: if (${$currentref}->[0] eq 'openp') {
277: my($mark) = ${$currentref}->[2];
278: my $position = 1+$mark->[0];
279: return $self->error("Unclosed parentheses beginning at position $position"
280: , $mark);
281: }
282: }
283: # Ok, we must really have parsed something
284: return $self->{parseresult};
285: }
286: } else {
287: my($mark) = pop @{$self->{posarray}};
288: my $position = 1+$mark->[0];
289: return $self->error("Illegal character at position $position",$mark);
290: }
291: }
292:
293: sub arraytoexpr {
294: my ($self) = shift;
295: return Expr->fromarray(@_);
296: }
297:
298: sub error {
299: my($self, $errstr, @markers) = @_;
300: # print STDERR Data::Dumper->Dump([\@markers],
301: # ['$markers']);
302: $self->{parseerror} = $errstr;
303: my($htmledstring) = '<tt class="parseinput">';
304: my($str) = $self->{string};
305: # print STDERR Data::Dumper->Dump([$str], ['$str']);
306: my($lastpos) = 0;
307: $str =~ s/ /\240/g;
308: while(@markers) {
309: my($ref) = shift @markers;
310: my($pos1) = $ref->[0];
311: my($pos2) = $ref->[1];
312: if (!defined($pos2)) {$pos2 = $pos1+1;}
313: $htmledstring .= encode_entities(substr($str,$lastpos,$pos1-$lastpos)) .
314: '<b class="parsehilight">' .
315: encode_entities(substr($str,$pos1,$pos2-$pos1)) .
316: '</b>';
317: $lastpos = $pos2;
318: }
319: # print STDERR Data::Dumper->Dump([$str, $htmledstring, $lastpos],
320: # ['$str', '$htmledstring', '$lastpos']);
321: $htmledstring .= encode_entities(substr($str,$lastpos));
322: $htmledstring .= '</tt>';
323: # $self->{htmlerror} = '<p class="parseerr">' . "\n" .
324: # '<span class="parsedesc">' .
325: # encode_entities($errstr) . '</span><br>' . "\n" .
326: # $htmledstring . "\n" . '</p>' . "\n";
327: $self->{htmlerror} = $htmledstring ;
328: $self->{htmlerror} = 'empty' if $errstr eq 'empty';
329: $self->{error_msg} = $errstr;
330:
331: # warn $errstr . "\n";
332: return undef;
333: }
334:
335: sub tostring {
336: my ($self) = shift;
337: return $self->{parseresult}->tostring(@_);
338: }
339:
340: sub tolatex {
341: my ($self) = shift;
342: return $self->{parseresult}->tolatex(@_);
343: }
344:
345: sub tolatexstring { return tolatex(@_);}
346:
347: sub exprtolatexstr {
348: return exprtolatex(@_);
349: }
350:
351: sub exprtolatex {
352: my($expr) = shift;
353: my($exprobj);
354: if ((ref $expr) eq 'ARRAY') {
355: $exprobj = Expr->new(@$expr);
356: } else {
357: $exprobj = $expr;
358: }
359: return $exprobj->tolatex();
360: }
361:
362: sub exprtostr {
363: my($expr) = shift;
364: my($exprobj);
365: if ((ref $expr) eq 'ARRAY') {
366: $exprobj = Expr->new(@$expr);
367: } else {
368: $exprobj = $expr;
369: }
370: return $exprobj->tostring();
371: }
372:
373: sub normalize {
374: my ($self, $degree) = @_;
375: $self->{parseresult} = $self->{parseresult}->normalize($degree);
376: }
377:
378: sub normalize_expr {
379: my($expr, $degree) = @_;
380: my($exprobj);
381: if ((ref $expr) eq 'ARRAY') {
382: $exprobj = Expr->new(@$expr);
383: } else {
384: $exprobj = $expr;
385: }
386: return $exprobj->normalize($degree);
387: }
388:
389: package AlgParserWithImplicitExpand;
1.2 albertel 390: no strict;
1.1 albertel 391: @ISA=qw(AlgParser);
1.2 albertel 392: use strict;
1.1 albertel 393:
394: sub arraytoexpr {
395: my ($self) = shift;
396: my ($foo) = ExprWithImplicitExpand->fromarray(@_);
397: # print STDERR Data::Dumper->Dump([$foo],['retval']);
398: return $foo;
399: }
400:
401: package Expr;
402:
403: sub new {
404: my($class) = shift;
405: my(@args) = @_;
406: my($ret) = [@args];
407: return (bless $ret, $class);
408: }
409:
410: sub head {
411: my($self) = shift;
412: return ($self->[0]);
413: }
414:
415:
416: sub normalize {
417: #print STDERR "normalize\n";
418: #print STDERR Data::Dumper->Dump([@_]);
419:
420: my($self, $degree) = @_;
421: my($class) = ref $self;
422: $degree = $degree || 0;
423: my($type, @args) = @$self;
424: local $_;
425: $_ = $type;
426: my ($ret) = [$type, @args];
427:
428:
429: if(/closep/) {
430: $ret = $args[1]->normalize($degree);
431: } elsif (/unop1/) {
432: $ret = $class->new($type, $args[0], $args[1]->normalize($degree));
433: } elsif (/binop/) {
434: $ret = $class->new($type, $args[0], $args[1]->normalize($degree),
435: $args[2]->normalize($degree));
436: } elsif (/func1/) {
437: $args[0] =~ s/^arc/a/;
438: $ret = $class->new($type, $args[0], $args[1]->normalize($degree));
439: }
440:
441:
442: if ($degree < 0) {return $ret;}
443:
444:
445: ($type, @args) = @$ret;
446: $ret = $class->new($type, @args);
447: $_ = $type;
448: if (/binop1/ && ($args[2]->[0] =~ 'unop1')) {
449: my($h1, $h2) = ($args[0], $args[2]->[1]);
450: my($s1, $s2) = ($h1 eq '-', $h2 eq '-');
451: my($eventual) = ($s1==$s2);
452: if ($eventual) {
453: $ret = $class->new('binop1', '+', $args[1], $args[2]->[2] );
454: } else {
455: $ret = $class->new('binop1', '-', $args[1], $args[2]->[2] );
456: }
457: } elsif (/binop2/ && ($args[1]->[0] =~ 'unop1')) {
458: $ret = $class->new('unop1', '-',
459: $class->new($type, $args[0], $args[1]->[2],
460: $args[2])->normalize($degree) );
461: } elsif (/binop[12]/ && ($args[2]->[0] eq $type) &&
462: ($args[0] =~ /[+*]/)) {
463: # Remove frivolous right-association
464: # For example, fix 3+(4-5) or 3*(4x)
465: $ret = $class->new($type, $args[2]->[1],
466: $class->new($type, $args[0], $args[1],
467: $args[2]->[2])->normalize($degree),
468: $args[2]->[3]);
469: } elsif (/unop1/ && ($args[0] eq '+')) {
470: $ret = $args[1];
471: } elsif (/unop1/ && ($args[1]->[0] =~ 'unop1')) {
472: $ret = $args[1]->[2];
473: }
474: if ($degree > 0) {
475: }
476: return $ret;
477: }
478:
479: sub tostring {
480: # print STDERR "Expr::tostring\n";
481: # print STDERR Data::Dumper->Dump([@_]);
482: my($self) = shift;
483: my($type, @args) = @$self;
484: local $_;
485: $_ = $type;
486: /binop1/ && do {
487: my ($p1, $p2) = ('','');
488: if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ ( ) };}
489: return ($args[1]->tostring() . $args[0] . $p1 .
490: $args[2]->tostring() . $p2);
491: };
492: /unop1/ && do {
493: my ($p1, $p2) = ('','');
494: if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ ( ) };}
495: return ($args[0] . $p1 . $args[1]->tostring() . $p2);
496: };
497: /binop2/ && do {
498: my ($p1, $p2, $p3, $p4)=('','','','');
499: if ($args[0] =~ /implicit/) {$args[0] = ' ';}
500: if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ ( ) };}
501: # if ($args[2]->[0] =~ /binop[12]/) {($p3,$p4)=qw{ ( ) };}
502: if ($args[2]->[0] =~ /binop[12]|unop1/) {($p3,$p4)=qw{ ( ) };}
503: return ($p1 . $args[1]->tostring() . $p2 . $args[0] . $p3 .
504: $args[2]->tostring() . $p4);
505: };
506: /binop3/ && do {
507: my ($p1, $p2, $p3, $p4)=('','','','');
508: # if ($args[1]->[0] =~ /binop[123]|numberE/) {($p1,$p2)=qw{ ( ) };}
509: if ($args[1]->[0] =~ /binop[123]|unop1|numberE/) {($p1,$p2)=qw{ ( ) };}
510: # if ($args[2]->[0] =~ /binop[12]|numberE/) {($p3,$p4)=qw{ ( ) };}
511: if ($args[2]->[0] =~ /binop[12]|unop1|numberE/) {($p3,$p4)=qw{ ( ) };}
512: return ($p1 . $args[1]->tostring() . $p2 . $args[0] . $p3 .
513: $args[2]->tostring() . $p4);
514: };
515: /func1/ && do {
516: return ($args[0] . '(' . $args[1]->tostring() . ')');
517: };
518: /special|varname|numberE?/ && return $args[0];
519: /closep/ && do {
520: my(%close) = %AlgParser::close;
521:
522:
523:
524: return ($args[0] . $args[1]->tostring() . $close{$args[0]});
525: };
526: }
527:
528: sub tolatex {
529: my($self) = shift;
530: my($type, @args) = @$self;
531: local $_;
532: $_ = $type;
533: /binop1/ && do {
534: my ($p1, $p2) = ('','');
535: if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ \left( \right) };}
536: return ($args[1]->tolatex() . $args[0] . $p1 .
537: $args[2]->tolatex() . $p2);
538: };
539: /unop1/ && do {
540: my ($p1, $p2) = ('','');
541: if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ \left( \right) };}
542: return ($args[0] . $p1 . $args[1]->tolatex() . $p2);
543: };
544: /binop2/ && do {
545: my ($p1, $p2, $p3, $p4) = ('','','','');
546: if ($args[0] =~ /implicit/) {
547: if ( (($args[1]->head eq qq(number)) &&
548: ($args[2]->head eq qq(number))) ||
549: (($args[1]->head eq qq(binop2)) &&
550: ($args[1]->[2]->head eq qq(number))) ) {
551: $args[0] = '\\,';
552: } else {
553: $args[0] = ' ';
554: }
555: }
556: if ($args[1]->[0] =~ /binop1|numberE/)
557: {($p1,$p2)=qw{ \left( \right) };}
558: # if ($args[2]->[0] =~ /binop[12]|numberE/)
559: if ($args[2]->[0] =~ /binop[12]|numberE|unop1/)
560: {($p3,$p4)=qw{ \left( \right) };}
561: if ($args[0] eq '/'){
562: # return('\frac{' . $p1 . $args[1]->tolatex() . $p2 . '}'.
563: # '{' . $p3 . $args[2]->tolatex() . $p4 . '}' );
564: return('\frac{' . $args[1]->tolatex() . '}'.
565: '{' . $args[2]->tolatex() . '}' );
566: }
1.2 albertel 567: elsif ($args[0] eq '*'){
568: # return('\frac{' . $p1 . $args[1]->tolatex() . $p2 . '}'.
569: # '{' . $p3 . $args[2]->tolatex() . $p4 . '}' );
570: return($args[1]->tolatex() . '\cdot ' . $args[2]->tolatex() );
571: }
1.1 albertel 572: else{
573: return ($p1 . $args[1]->tolatex() . $p2 . $args[0] . $p3 .
574: $args[2]->tolatex() . $p4);
575: }
576: };
577: /binop3/ && do {
578: my ($p1, $p2, $p3, $p4)=('','','','');
579: # if ($args[1]->[0] =~ /binop[123]|numberE/) {($p1,$p2)=qw{ \left( \right) };}
580: if ($args[1]->[0] =~ /binop[123]|unop1|numberE/) {($p1,$p2)=qw{ \left( \right) };}
581: # Not necessary in latex
582: # if ($args[2]->[0] =~ /binop[12]/) {($p3,$p4)=qw{ \left( \right) };}
583: return ($p1 . $args[1]->tolatex() . $p2 . "^{" . $p3 .
584: $args[2]->tolatex() . $p4 . "}");
585: };
586: /func1/ && do {
587: my($p1,$p2);
588: if($args[0] eq "sqrt"){($p1,$p2)=qw{ \left{ \right} };}
589: else {($p1,$p2)=qw{ \left( \right) };}
590:
591: #
592: # DPVC -- 2003/03/31
593: # added missing trig functions
594: #
595: #$specialfunc = '(?:abs|logten|asin|acos|atan|sech|sgn|step|fact)';
1.2 albertel 596: my $specialfunc = '(?:abs|logten|a(?:sin|cos|tan|sec|csc|cot)h?|sgn|step|fact)';
1.1 albertel 597: #
598: # End DPVC
599: #
600:
601: if ($args[0] =~ /$specialfunc/) {
602: return ('\mbox{' . $args[0] .'}'. $p1 . $args[1]->tolatex() . $p2);
603: }
604: else {
605: return ('\\' . $args[0] . $p1 . $args[1]->tolatex() . $p2);
606: }
607: };
608: /special/ && do {
609: if ($args[0] eq 'pi') {return '\pi';} else {return $args[0];}
610: };
611: /varname|(:?number$)/ && return $args[0];
612: /numberE/ && do {
613: $args[0] =~ m/($AlgParser::numberplain)E([-+]?\d+)/;
614: return ($1 . '\times 10^{' . $2 . '}');
615: };
616: /closep/ && do {
617: my($backslash) = '';
618: my(%close) = %AlgParser::close;
619: if ($args[0] eq '{') {$backslash = '\\';}
620: #This is for editors to match: }
621: return ('\left' . $backslash . $args[0] . $args[1]->tolatex() .
622: '\right' . $backslash . $close{$args[0]});
623: };
624: }
625:
626: sub fromarray {
627: my($class) = shift;
628: my($expr) = shift;
629: if ((ref $expr) ne qq{ARRAY}) {
630: die "Program error; fromarray not passed an array ref.";
631: }
632: my($type, @args) = @$expr;
633: foreach my $i (@args) {
634: if (ref $i) {
635: $i = $class->fromarray($i);
636: }
637: }
638: return $class->new($type, @args);
639: }
640:
641: package ExprWithImplicitExpand;
1.2 albertel 642: no strict;
1.1 albertel 643: @ISA=qw(Expr);
1.2 albertel 644: use strict;
1.1 albertel 645:
646: sub tostring {
647: # print STDERR "ExprWIE::tostring\n";
648: # print STDERR Data::Dumper->Dump([@_]);
649: my ($self) = shift;
650:
651: my($type, @args) = @$self;
652:
653: if (($type eq qq(binop2)) && ($args[0] eq qq(implicit))) {
654: my ($p1, $p2, $p3, $p4)=('','','','');
655: if ($args[1]->head =~ /binop1/) {($p1,$p2)=qw{ ( ) };}
656: # if ($args[2]->head =~ /binop[12]/) {($p3,$p4)=qw{ ( ) };}
657: if ($args[2]->head =~ /binop[12]|unop1/) {($p3,$p4)=qw{ ( ) };}
658: return ($p1 . $args[1]->tostring() . $p2 . '*' . $p3 .
659: $args[2]->tostring() . $p4);
660: } else {
661: return $self->SUPER::tostring(@_);
662: }
663: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to AlgParser.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml / algebra