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