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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4363 - (download) (as text) (annotate)
Wed Aug 9 14:32:14 2006 UTC (11 years, 11 months ago) by sh002i
File size: 19746 byte(s)
append "1;" to these files, to satisfy Apache2.

    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;
    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 #
   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 $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 
   97   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 
  142         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         return $self->error("Didn't expect " . $currenttok->[1] .
  157                             " 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         return $self->error("Didn't expect " . $currenttok->[1] .
  180                             " 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           return $self->error("Mismatched parens at position $position"
  227                               , ${$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           return $self->error("Unclosed parentheses beginning at position $position"
  276                          , $mark);
  277         }
  278       }
  279       # Ok, we must really have parsed something
  280       return $self->{parseresult};
  281     }
  282   } 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 #  print STDERR Data::Dumper->Dump([\@markers],
  297 #                                  ['$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 #  print STDERR Data::Dumper->Dump([$str, $htmledstring, $lastpos],
  316 #                                  ['$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   $self->{error_msg} = $errstr;
  326 
  327 #  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 
  414   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     my($h1, $h2) = ($args[0], $args[2]->[1]);
  444     my($s1, $s2) = ($h1 eq '-', $h2 eq '-');
  445     my($eventual) = ($s1==$s2);
  446     if ($eventual) {
  447       $ret = $class->new('binop1', '+', $args[1], $args[2]->[2] );
  448     } else {
  449       $ret = $class->new('binop1', '-', $args[1], $args[2]->[2] );
  450     }
  451   } elsif (/binop2/ && ($args[1]->[0] =~ 'unop1')) {
  452     $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                           ($args[0] =~ /[+*]/)) {
  457 # Remove frivolous right-association
  458 # For example, fix 3+(4-5) or 3*(4x)
  459     $ret = $class->new($type, $args[2]->[1],
  460                        $class->new($type, $args[0], $args[1],
  461                                    $args[2]->[2])->normalize($degree),
  462                        $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 
  516 
  517 
  518     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     my ($p1, $p2, $p3, $p4)=('','','','');
  540     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       }
  549       return ($p1.$lop.$p2. $args[0] .$p3.$rop.$p4);
  550     }
  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       if($args[0] eq "sqrt"){($p1,$p2)=('{','}');}
  564       else {($p1,$p2)=qw{ \left( \right) };}
  565 
  566       #
  567       #  DPVC -- 2003/03/31
  568       #       added missing trig functions
  569       #
  570       #$specialfunc = '(?:abs|logten|asin|acos|atan|sech|sgn|step|fact)';
  571       $specialfunc = '(?:abs|logten|a(?:sin|cos|tan|sec|csc|cot)h?|sech|csch|sgn|step|fact)';
  572       #
  573       #  End DPVC
  574       #
  575 
  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       }
  582   };
  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     return ('\left' . $backslash . $args[0] . $args[1]->tolatex() .
  597             '\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 
  639 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9