filter/algebra/AlgParser.pm

   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|da|db|dc|de|df|dg|dh|di|dj|dk|dl|dm|dn|do|dp|dq|dr|ds|dt|du|dv|dw|dx|dy|dz|infty|alpha|bita|gamma|zita|thita|iota|kappa|lambda|mu|nu|xi|rho|sigma|tau|phi|chi|psi|omega|zepslon|zdelta|xeta|zupslon|zeroplace)';
  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|int|lim|fun[a-zA-Z])';
  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     if ($args[0] =~ /implicit/) {
 541       if ( (($args[1]->head eq qq(number)) &&
 542             ($args[2]->head eq qq(number))) ||
 543            (($args[1]->head eq qq(binop2)) &&
 544             ($args[1]->[2]->head eq qq(number))) ) {
 545         $args[0] = '\\,';
 546       } else {
 547         $args[0] = ' ';
 548       }
 549     }
 550     if ($args[1]->[0] =~ /binop1|numberE/)
 551       {($p1,$p2)=qw{ \left( \right) };}
 552  #   if ($args[2]->[0] =~ /binop[12]|numberE/)
 553         if ($args[2]->[0] =~ /binop[12]|numberE|unop1/)
 554       {($p3,$p4)=qw{ \left( \right) };}
 555     if ($args[0] eq '/'){
 556 #       return('\frac{' . $p1 . $args[1]->tolatex() . $p2 . '}'.
 557 #               '{' . $p3 . $args[2]->tolatex() . $p4 . '}' );
 558         return('\frac{' . $args[1]->tolatex() . '}'.
 559                '{' . $args[2]->tolatex() . '}' );
 560     }
 561     else{
 562     return ($p1 . $args[1]->tolatex() . $p2 . $args[0] . $p3 .
 563             $args[2]->tolatex() . $p4);
 564     }
 565   };
 566   /binop3/ && do {
 567     my ($p1, $p2, $p3, $p4)=('','','','');
 568 #    if ($args[1]->[0] =~ /binop[123]|numberE/) {($p1,$p2)=qw{ \left( \right) };}
 569   if ($args[1]->[0] =~ /binop[123]|unop1|numberE/) {($p1,$p2)=qw{ \left( \right) };}
 570 # Not necessary in latex
 571 #   if ($args[2]->[0] =~ /binop[12]/) {($p3,$p4)=qw{ \left( \right) };}
 572     return ($p1 . $args[1]->tolatex() . $p2 . "^{" . $p3 .
 573             $args[2]->tolatex() . $p4 . "}");
 574   };
 575   /func1/ && do {
 576       my($p1,$p2);
 577       if($args[0] eq "sqrt"){($p1,$p2)=qw{ \left{ \right} };}
 578       else {($p1,$p2)=qw{ \left( \right) };}
 579
 580       #
 581       #  DPVC -- 2003/03/31
 582       #       added missing trig functions
 583       #
 584       #$specialfunc = '(?:abs|logten|asin|acos|atan|sech|sgn|step|fact)';
 585       $specialfunc = '(?:abs|logten|a(?:sin|cos|tan|sec|csc|cot)h?|sgn|step|fact)';
 586       #
 587       #  End DPVC
 588       #
 589
 590       if ($args[0] =~ /$specialfunc/) {
 591          return ('\mbox{' . $args[0] .'}'. $p1 . $args[1]->tolatex() . $p2);
 592       }
 593       else {
 594         return ('\\' . $args[0] . $p1 . $args[1]->tolatex() . $p2);
 595       }
 596   };
 597   /special/ && do {
 598     if ($args[0] eq 'pi') {return '\pi';} else {return $args[0];}
 599   };
 600   /varname|(:?number$)/ && return $args[0];
 601   /numberE/ && do {
 602     $args[0] =~ m/($AlgParser::numberplain)E([-+]?\d+)/;
 603     return ($1 . '\times 10^{' . $2 . '}');
 604   };
 605   /closep/ && do {
 606     my($backslash) = '';
 607     my(%close) = %AlgParser::close;
 608     if ($args[0] eq '{') {$backslash = '\\';}
 609 #This is for editors to match: }
 610     return ('\left' . $backslash . $args[0] . $args[1]->tolatex() .
 611             '\right' . $backslash . $close{$args[0]});
 612   };
 613 }
 614
 615 sub fromarray {
 616   my($class) = shift;
 617   my($expr) = shift;
 618   if ((ref $expr) ne qq{ARRAY}) {
 619     die "Program error; fromarray not passed an array ref.";
 620   }
 621   my($type, @args) = @$expr;
 622   foreach my $i (@args) {
 623     if (ref $i) {
 624       $i = $class->fromarray($i);
 625     }
 626   }
 627   return $class->new($type, @args);
 628 }
 629
 630 package ExprWithImplicitExpand;
 631 @ISA=qw(Expr);
 632
 633
 634 sub tostring {
 635 # print STDERR "ExprWIE::tostring\n";
 636 # print STDERR Data::Dumper->Dump([@_]);
 637   my ($self) = shift;
 638
 639   my($type, @args) = @$self;
 640
 641   if (($type eq qq(binop2)) && ($args[0] eq qq(implicit))) {
 642     my ($p1, $p2, $p3, $p4)=('','','','');
 643     if ($args[1]->head =~ /binop1/) {($p1,$p2)=qw{ ( ) };}
 644 #    if ($args[2]->head =~ /binop[12]/) {($p3,$p4)=qw{ ( ) };}
 645     if ($args[2]->head =~ /binop[12]|unop1/) {($p3,$p4)=qw{ ( ) };}
 646     return ($p1 . $args[1]->tostring() . $p2 . '*' . $p3 .
 647             $args[2]->tostring() . $p4);
 648   } else {
 649     return $self->SUPER::tostring(@_);
 650   }
 651 }