Return to AlgParser.pm CVS log

Up to [LON-CAPA] / loncom / xml / algebra

- properly handle -10 = -10 and throw error on -10 -=10

    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: use strict;
   10: 
   11: package AlgParser;
   12: use HTML::Entities;
   13: 
   14: my %close = ();
   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: 
   40: my $binoper3 = '(?:\\^|\\*\\*)';
   41: my $binoper2 = '[/*_,]';
   42: my $binoper1 = '(?:[-+%!])';
   43: my $binoper0 = '(?:<>|<=|>=|[=><])';
   44: my $openparen = '[{(\\[]';
   45: my $closeparen = '[})\\]]';
   46: my $varname = '[A-Za-z](?:_[0-9]+)?';
   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';
   48: my $delete='zeroplace';
   49: my $escape='infty';
   50: my $specialvalue = '(?:'.$escape.'|'.$greek.'|'.$delete.'|d[a-z]|e)';
   51: 
   52: my $numberplain = '(?:\d+(?:\.\d*)?|\.\d+)';
   53: my $numberE = '(?:' . $numberplain . 'E[-+]?\d+)';
   54: my $number = '(?:' . $numberE . '|' . $numberplain . ')';
   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?)';
   61: my $trigfname = '(?:(?:a(?:rc)?)?(?:sin|cos|tan|sec|csc|cot)h?)';
   62: #
   63: #  End DPVC
   64: #
   65: my $otherfunc = '(?:exp|abs|logten|log|ln|sqrt|sgn|step|fact|int|lim|fun[a-zA-Z])';
   66: my $funcname = '(?:' . $otherfunc . '|' . $trigfname . ')';
   67: 
   68: my $tokenregexp = "(?:($binoper3)|($binoper2)|($binoper1)|($binoper0)|($openparen)|" .
   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];}
   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];}
   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];
  105:   my $currenttok;
  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];
  123:     /binop[01]/ && do {
  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);
  131:         ${$currentref}->[$index] = [$currenttok->[0], $currenttok->[1],
  132:                                     ${$currentref}->[$index], undef];
  133:         push @backtrace, $currentref;
  134:         push @backtrace, \${$currentref}->[$index];
  135:         $currentref = \${$currentref}->[$index]->[3];
  136:       } elsif (/binop1/) {
  137:         # unary
  138:         ${$currentref} = ['unop1', $currenttok->[1], undef];
  139:         push @backtrace, $currentref;
  140:         $currentref = \${$currentref}->[2];
  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);
  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;
  398: no strict;
  399: @ISA=qw(AlgParser);
  400: use strict;
  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;
  492: 
  493:   local $_;
  494:   $_ = $type;
  495:   /binop[01]/ && do {
  496:     my ($p1, $p2) = ('','');
  497:     if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ ( ) };}
  498:     return ($args[1]->tostring() . $args[0] . $p1 .
  499:             $args[2]->tostring() . $p2);
  500:   };
  501:   /unop1/ && do {
  502:     my ($p1, $p2) = ('','');
  503:     if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ ( ) };}
  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] = ' ';}
  509:     if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ ( ) };}
  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;
  537: 
  538:   local $_;
  539:   $_ = $type;
  540:   /binop[01]/ && do {
  541:     my ($p1, $p2) = ('','');
  542:     if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ \left( \right) };}
  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 .
  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 {
  556:     my ($lop,$rop) = ($args[1]->tolatex,$args[2]->tolatex);
  557:     if ($args[0] eq '/'){
  558: 	return('\frac{'.$lop.'}{'.$rop.'}');
  559:     }
  560:     my $op = $args[0];
  561:     if ($args[0] eq '*'){
  562: 	$op = '\cdot ';
  563:     }
  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 ' : ' ';
  568:     }
  569:     return ($lop.$op.$rop);
  570: 
  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);
  583:       if($args[0] eq "sqrt"){($p1,$p2)=('{','}');}
  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)';
  591:       my $specialfunc = '(?:(logten)|a(sin|cos|tan|sec|csc|cot)(h)?|sgn|step|fact|(abs))';
  592:       #
  593:       #  End DPVC
  594:       #
  595: 
  596:       if ($args[0] =~ /$specialfunc/) {
  597: 	  if (defined($1)) {
  598: 	      return ('\log_{10}'. $p1 . $args[1]->tolatex() . $p2);
  599: 	  }
  600: 	  elsif (defined($2)) {
  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: 	      }
  606: 	  }
  607: 	  elsif (defined($4)) {
  608: 	      return ('|' . $args[1]->tolatex() . '|');
  609: 	  }
  610: 	  else {
  611: 	      return ('\mbox{' . $args[0] .'}'. $p1 . $args[1]->tolatex() . $p2);
  612: 	  }
  613:       }
  614:       else {
  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: 	  }
  620:       }
  621:   };
  622:   /special/ && do {
  623:       if    ($args[0] =~/($greek|$escape)/) {return '\\'.$1;}
  624:       elsif ($args[0] =~/$delete/) {return '';}
  625:       else { return $args[0]; }
  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;
  657: no strict;
  658: @ISA=qw(Expr);
  659: use strict;
  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: }