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