Annotation of loncom/xml/algebra/AlgParser.pm, revision 1.1
1.1 ! albertel 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: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to AlgParser.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml / algebra