[BACK]Return to AlgParser.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / xml / algebra

Diff for /loncom/xml/algebra/AlgParser.pm between versions 1.1 and 1.15

version 1.1, 2005/02/24 01:21:51 version 1.15, 2006/03/13 19:23:46
Line 6 Line 6
 ## Additions and modifications were made by Arnold Pizer, Dept of Math, Univ of Rochester  ## Additions and modifications were made by Arnold Pizer, Dept of Math, Univ of Rochester
   
 #use Data::Dumper;  #use Data::Dumper;
   use strict;
   
 package AlgParser;  package AlgParser;
 use HTML::Entities;  use HTML::Entities;
   
 %close = ();  my %close = ();
   
 sub new {  sub new {
   my $package = shift;    my $package = shift;
Line 36  $close{'{'} = '}'; Line 37  $close{'{'} = '}';
 $close{'['} = ']';  $close{'['} = ']';
 $close{'('} = ')';  $close{'('} = ')';
   
 $binoper3 = '(?:\\^|\\*\\*)';  my $binoper3 = '(?:\\^|\\*\\*)';
 $binoper2 = '[/*_,]';  my $binoper2 = '[/*_,]';
 $binoper1 = '[-+=><%!#]';  my $binoper1 = '(?:<>|<=|>=|[-+=><%!])';
 $openparen = '[{(\\[]';  my $openparen = '[{(\\[]';
 $closeparen = '[})\\]]';  my $closeparen = '[})\\]]';
 $varname = '[A-Za-z](?:_[0-9]+)?';  my $varname = '[A-Za-z](?:_[0-9]+)?';
 $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)';  my $greek='alpha|(?:(?:(?:var)?(?:[tT]h))|(?:[bz])?)eta|[gG]amma|iota|kappa|[lL]ambda|mu|nu|[xX]i|(?:var)?rho|(?:var)?[sS]igma|tau|(?:var)?(?:[pP])hi|chi|[oO]mega|(?:(?:var)?(?:[eE])|(?:[uU]))psilon|[dD]elta|[pP]si|(?:var)?[pP]i';
 $numberplain = '(?:\d+(?:\.\d*)?|\.\d+)';  my $delete='zeroplace';
 $numberE = '(?:' . $numberplain . 'E[-+]?\d+)';  my $escape='infty';
 $number = '(?:' . $numberE . '|' . $numberplain . ')';  my $specialvalue = '(?:'.$escape.'|'.$greek.'|'.$delete.'|d[a-z]|e)';
   
   my $numberplain = '(?:\d+(?:\.\d*)?|\.\d+)';
   my $numberE = '(?:' . $numberplain . 'E[-+]?\d+)';
   my $number = '(?:' . $numberE . '|' . $numberplain . ')';
 #  #
 #  DPVC -- 2003/03/31  #  DPVC -- 2003/03/31
 #       added missing trig and inverse functions  #       added missing trig and inverse functions
 #  #
 #$trigfname = '(?:cosh|sinh|tanh|cot|(?:a(?:rc)?)?cos|(?:a(?:rc)?)?sin|' .  #$trigfname = '(?:cosh|sinh|tanh|cot|(?:a(?:rc)?)?cos|(?:a(?:rc)?)?sin|' .
 #    '(?:a(?:rc)?)?tan|sech?)';  #    '(?:a(?:rc)?)?tan|sech?)';
 $trigfname = '(?:(?:a(?:rc)?)?(?:sin|cos|tan|sec|csc|cot)h?)';  my $trigfname = '(?:(?:a(?:rc)?)?(?:sin|cos|tan|sec|csc|cot)h?)';
 #  #
 #  End DPVC  #  End DPVC
 #  #
 $otherfunc = '(?:exp|abs|logten|log|ln|sqrt|sgn|step|fact|int|lim|fun[a-zA-Z])';  my $otherfunc = '(?:exp|abs|logten|log|ln|sqrt|sgn|step|fact|int|lim|fun[a-zA-Z])';
 $funcname = '(?:' . $otherfunc . '|' . $trigfname . ')';  my $funcname = '(?:' . $otherfunc . '|' . $trigfname . ')';
   
 $tokenregexp = "(?:($binoper3)|($binoper2)|($binoper1)|($openparen)|" .  my $tokenregexp = "(?:($binoper3)|($binoper2)|($binoper1)|($openparen)|" .
     "($closeparen)|($funcname)|($specialvalue)|($varname)|" .      "($closeparen)|($funcname)|($specialvalue)|($varname)|" .
     "($numberE)|($number))";      "($numberE)|($number))";
   
Line 95  sub parse { Line 100  sub parse {
   my (@pushback) = ();    my (@pushback) = ();
   
   my $currentref = \$self->{parseresult}->[1];    my $currentref = \$self->{parseresult}->[1];
   my $curenttok;    my $currenttok;
   
   my $sstring = shift;    my $sstring = shift;
   $self->inittokenizer($sstring);    $self->inittokenizer($sstring);
Line 383  sub normalize_expr { Line 388  sub normalize_expr {
 }  }
   
 package AlgParserWithImplicitExpand;  package AlgParserWithImplicitExpand;
   no strict;
 @ISA=qw(AlgParser);  @ISA=qw(AlgParser);
   use strict;
   
 sub arraytoexpr {  sub arraytoexpr {
   my ($self) = shift;    my ($self) = shift;
Line 475  sub tostring { Line 482  sub tostring {
 # print STDERR Data::Dumper->Dump([@_]);  # print STDERR Data::Dumper->Dump([@_]);
   my($self) = shift;    my($self) = shift;
   my($type, @args) = @$self;    my($type, @args) = @$self;
   
   local $_;    local $_;
   $_ = $type;    $_ = $type;
   /binop1/ && do {    /binop1/ && do {
     my ($p1, $p2) = ('','');      my ($p1, $p2) = ('','');
     if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ ( ) };}      if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ [ ] };}
     return ($args[1]->tostring() . $args[0] . $p1 .      return ($args[1]->tostring() . $args[0] . $p1 .
             $args[2]->tostring() . $p2);              $args[2]->tostring() . $p2);
   };    };
   /unop1/ && do {    /unop1/ && do {
     my ($p1, $p2) = ('','');      my ($p1, $p2) = ('','');
     if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ ( ) };}      if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ [ ] };}
     return ($args[0] . $p1 . $args[1]->tostring() . $p2);      return ($args[0] . $p1 . $args[1]->tostring() . $p2);
   };    };
   /binop2/ && do {    /binop2/ && do {
     my ($p1, $p2, $p3, $p4)=('','','','');      my ($p1, $p2, $p3, $p4)=('','','','');
     if ($args[0] =~ /implicit/) {$args[0] = ' ';}      if ($args[0] =~ /implicit/) {$args[0] = ' ';}
     if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ ( ) };}      if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ [ ] };}
 #    if ($args[2]->[0] =~ /binop[12]/) {($p3,$p4)=qw{ ( ) };}  #    if ($args[2]->[0] =~ /binop[12]/) {($p3,$p4)=qw{ ( ) };}
     if ($args[2]->[0] =~ /binop[12]|unop1/) {($p3,$p4)=qw{ ( ) };}      if ($args[2]->[0] =~ /binop[12]|unop1/) {($p3,$p4)=qw{ ( ) };}
     return ($p1 . $args[1]->tostring() . $p2 . $args[0] . $p3 .      return ($p1 . $args[1]->tostring() . $p2 . $args[0] . $p3 .
Line 511  sub tostring { Line 519  sub tostring {
   };    };
   /special|varname|numberE?/ && return $args[0];    /special|varname|numberE?/ && return $args[0];
   /closep/ && do {    /closep/ && do {
     my(%close) = %AlgParser::close;  
   
   
   
     return ($args[0] . $args[1]->tostring() . $close{$args[0]});      return ($args[0] . $args[1]->tostring() . $close{$args[0]});
   };    };
Line 522  sub tostring { Line 527  sub tostring {
 sub tolatex {  sub tolatex {
   my($self) = shift;    my($self) = shift;
   my($type, @args) = @$self;    my($type, @args) = @$self;
   
   local $_;    local $_;
   $_ = $type;    $_ = $type;
   /binop1/ && do {    /binop1/ && do {
     my ($p1, $p2) = ('','');      my ($p1, $p2) = ('','');
     if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ \left( \right) };}      if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ \left( \right) };}
     return ($args[1]->tolatex() . $args[0] . $p1 .      my $cmd=$args[0];
       if    ($args[0] eq '<>') { $cmd='\\not= '; }
       elsif ($args[0] eq '<=') { $cmd='\\leq ';  }
       elsif ($args[0] eq '>=') { $cmd='\\geq ';  }
       return ($args[1]->tolatex() . $cmd . $p1 .
             $args[2]->tolatex() . $p2);              $args[2]->tolatex() . $p2);
   };    };
   /unop1/ && do {    /unop1/ && do {
Line 536  sub tolatex { Line 546  sub tolatex {
     return ($args[0] . $p1 . $args[1]->tolatex() . $p2);      return ($args[0] . $p1 . $args[1]->tolatex() . $p2);
   };    };
   /binop2/ && do {    /binop2/ && do {
     my ($p1, $p2, $p3, $p4) = ('','','','');      my ($lop,$rop) = ($args[1]->tolatex,$args[2]->tolatex);
     if ($args[0] =~ /implicit/) {  
       if ( (($args[1]->head eq qq(number)) &&  
             ($args[2]->head eq qq(number))) ||  
            (($args[1]->head eq qq(binop2)) &&  
             ($args[1]->[2]->head eq qq(number))) ) {  
         $args[0] = '\\,';  
       } else {  
         $args[0] = ' ';  
       }  
     }  
     if ($args[1]->[0] =~ /binop1|numberE/)  
       {($p1,$p2)=qw{ \left( \right) };}  
  #   if ($args[2]->[0] =~ /binop[12]|numberE/)  
  if ($args[2]->[0] =~ /binop[12]|numberE|unop1/)  
       {($p3,$p4)=qw{ \left( \right) };}  
     if ($args[0] eq '/'){      if ($args[0] eq '/'){
 # return('\frac{' . $p1 . $args[1]->tolatex() . $p2 . '}'.   return('\frac{'.$lop.'}{'.$rop.'}');
 #               '{' . $p3 . $args[2]->tolatex() . $p4 . '}' );      }
  return('\frac{' . $args[1]->tolatex() . '}'.      my $op = $args[0];
                '{' . $args[2]->tolatex() . '}' );       if ($args[0] eq '*'){
    $op = '\cdot ';
     }      }
     else{      $lop = '\left('.$lop.'\right)' if ($args[1]->[0] =~ /binop1|numberE/);
     return ($p1 . $args[1]->tolatex() . $p2 . $args[0] . $p3 .      $rop = '\left('.$rop.'\right)' if ($args[2]->[0] =~ /binop[12]|numberE|unop1/);
             $args[2]->tolatex() . $p4);      if ($args[0] =~ /implicit/) {
    $op = ($lop =~ m/[.0-9]$/ && $rop =~ m/^[-+.0-9]/) ? '\cdot ' : ' ';
     }      }
       return ($lop.$op.$rop);
   
   };    };
   /binop3/ && do {    /binop3/ && do {
     my ($p1, $p2, $p3, $p4)=('','','','');      my ($p1, $p2, $p3, $p4)=('','','','');
Line 574  sub tolatex { Line 573  sub tolatex {
   };    };
   /func1/ && do {    /func1/ && do {
       my($p1,$p2);        my($p1,$p2);
       if($args[0] eq "sqrt"){($p1,$p2)=qw{ \left{ \right} };}        if($args[0] eq "sqrt"){($p1,$p2)=('{','}');}
       else {($p1,$p2)=qw{ \left( \right) };}        else {($p1,$p2)=qw{ \left( \right) };}
   
       #        #
Line 582  sub tolatex { Line 581  sub tolatex {
       #       added missing trig functions        #       added missing trig functions
       #        #
       #$specialfunc = '(?:abs|logten|asin|acos|atan|sech|sgn|step|fact)';        #$specialfunc = '(?:abs|logten|asin|acos|atan|sech|sgn|step|fact)';
       $specialfunc = '(?:abs|logten|a(?:sin|cos|tan|sec|csc|cot)h?|sgn|step|fact)';        my $specialfunc = '(?:(logten)|a(sin|cos|tan|sec|csc|cot)(h)?|sgn|step|fact|(abs))';
       #        #
       #  End DPVC        #  End DPVC
       #        #
   
       if ($args[0] =~ /$specialfunc/) {        if ($args[0] =~ /$specialfunc/) {
          return ('\mbox{' . $args[0] .'}'. $p1 . $args[1]->tolatex() . $p2);    if (defined($1)) {
         return ('\log_{10}'. $p1 . $args[1]->tolatex() . $p2);
     }
     elsif (defined($2)) {
         if (defined($3) && ($2 eq 'sec' || $2 eq 'csc' || $2 eq 'cot')) {
     return ('\mathrm{' . $2.$3 .'}^{-1}'. $p1 . $args[1]->tolatex() . $p2);
         } else {
     return ('\\' . $2.$3 .'^{-1}'. $p1 . $args[1]->tolatex() . $p2);
         }
     }
     elsif (defined($4)) {
         return ('|' . $args[1]->tolatex() . '|');
     }
     else {
         return ('\mbox{' . $args[0] .'}'. $p1 . $args[1]->tolatex() . $p2);
     }
       }        }
       else {        else {
         return ('\\' . $args[0] . $p1 . $args[1]->tolatex() . $p2);    if ($args[0] =~/(sec|csc|cot)h/) {
         return ('\mathrm{' . $args[0] . '}' . $p1 . $args[1]->tolatex() . $p2);
     } else {
         return ('\\' . $args[0] . $p1 . $args[1]->tolatex() . $p2);
     }
       }        }
   };    };
   /special/ && do {    /special/ && do {
     if ($args[0] eq 'pi') {return '\pi';} else {return $args[0];}        if    ($args[0] =~/($greek|$escape)/) {return '\\'.$1;}
         elsif ($args[0] =~/$delete/) {return '';}
         else { return $args[0]; }
   };    };
   /varname|(:?number$)/ && return $args[0];    /varname|(:?number$)/ && return $args[0];
   /numberE/ && do {    /numberE/ && do {
Line 604  sub tolatex { Line 624  sub tolatex {
   };    };
   /closep/ && do {    /closep/ && do {
     my($backslash) = '';      my($backslash) = '';
     my(%close) = %AlgParser::close;  
     if ($args[0] eq '{') {$backslash = '\\';}      if ($args[0] eq '{') {$backslash = '\\';}
 #This is for editors to match: }  #This is for editors to match: }     
     return ('\left' . $backslash . $args[0] . $args[1]->tolatex() .      return ('\left' . $backslash . $args[0] . $args[1]->tolatex() .
             '\right' . $backslash . $close{$args[0]});              '\right' . $backslash . $close{$args[0]});
   };    };
Line 628  sub fromarray { Line 647  sub fromarray {
 }  }
   
 package ExprWithImplicitExpand;  package ExprWithImplicitExpand;
   no strict;
 @ISA=qw(Expr);  @ISA=qw(Expr);
   use strict;
   
 sub tostring {  sub tostring {
 # print STDERR "ExprWIE::tostring\n";  # print STDERR "ExprWIE::tostring\n";
Removed from v.1.1  
changed lines
  Added in v.1.15

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>