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