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