[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/filter/algebra/ -> AlgParser.pm (source)

   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  }


Generated: Thu Aug 11 10:00:09 2016 Cross-referenced by PHPXref 0.7.1