[system] / trunk / pg / lib / AlgParser.pm Repository:
ViewVC logotype

Annotation of /trunk/pg/lib/AlgParser.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4363 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9