[system] / trunk / pg / lib / Parser / Function.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Parser/Function.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2696 - (download) (as text) (annotate)
Sat Aug 28 12:34:56 2004 UTC (15 years, 3 months ago) by dpvc
File size: 8574 byte(s)
Improved TeX and string output in a number of situations.  Improved
use of parentheses to avoid things like x+-3.  Fixed wrong parentheses
in powers.  Display (sin(x))^2 as sin^2(x) in TeX output.

    1 #########################################################################
    2 #
    3 #  Implements function calls
    4 #
    5 
    6 package Parser::Function;
    7 use strict; use vars qw(@ISA);
    8 @ISA = qw(Parser::Item);
    9 
   10 $Parser::class->{Function} = 'Parser::Function';
   11 
   12 sub new {
   13   my $self = shift; my $class = ref($self) || $self;
   14   my $equation = shift; my $context = $equation->{context};
   15   my ($name,$params,$constant,$ref) = @_;
   16   my $def = $context->{functions}{$name};
   17   $name = $def->{alias}, $def = $context->{functions}{$name} if defined $def->{alias};
   18   my $fn = bless {
   19     name => $name, params => $params,
   20     def => $def, ref => $ref, equation => $equation,
   21   }, $def->{class};
   22   $fn->_check;
   23   $fn = $context->{parser}{Value}->new($equation,[$fn->eval]) if $constant;
   24   return $fn;
   25 }
   26 
   27 #
   28 #  Stub to check if arguments are OK.
   29 #  (Implemented in sub-classes.)
   30 #
   31 sub _check {}
   32 
   33 ##################################################
   34 
   35 #
   36 #  Evaluate all the arguments and then perform the function
   37 #
   38 sub eval {
   39   my $self = shift; my @params = ();
   40   foreach my $x (@{$self->{params}}) {push(@params,$x->eval)}
   41   $self->_eval(@params);
   42 }
   43 #
   44 #  Stub for sub-classes
   45 #
   46 sub _eval {shift; return @_}
   47 
   48 #
   49 #  Reduce all the arguments and compute the function if they are
   50 #    all constant.
   51 #  Otherwise, let the sub-classes reduce it.
   52 #
   53 sub reduce {
   54   my $self = shift;
   55   my @params = (); my $constant = 1;
   56   foreach my $x (@{$self->{params}})
   57     {$x = $x->reduce; $constant = 0 unless $x->{isConstant}}
   58   return $self->{equation}{context}{parser}{Value}->
   59     new($self->{equation},[$self->eval]) if $constant;
   60   $self->_reduce;
   61 }
   62 #
   63 #  Stub for sub-classes.
   64 #
   65 sub _reduce {shift}
   66 
   67 #
   68 #  Substitute in each argument.
   69 #
   70 sub substitute {
   71   my $self = shift;
   72   my @params = (); my $constant = 1;
   73   foreach my $x (@{$self->{params}})
   74     {$x = $x->substitute; $constant = 0 unless $x->{isConstant}}
   75   return $self->{equation}{context}{parser}{Value}->
   76     new($self->{equation},[$self->eval]) if $constant;
   77   return $self;
   78 }
   79 
   80 #
   81 #  Copy the arguments as well as the function object
   82 #
   83 sub copy {
   84   my $self = shift; my $equation = shift;
   85   my $new = $self->SUPER::copy($equation);
   86   $new->{params} = [];
   87   foreach my $x (@{$self->{params}}) {push(@{$new->{params}},$x->copy($equation))}
   88   return $new;
   89 }
   90 
   91 #
   92 #  Create a new formula if the function's arguments are formulas
   93 #  Otherwise evaluate the function call.
   94 #
   95 #  (This is used to "overload" function calls so that they will
   96 #   work in Value.pm to produce formulas when called on formulas.)
   97 #
   98 sub call {
   99   my $self = shift; my $name = shift;
  100   my $context = Parser::Context->current;
  101   my $fn = $context->{functions}{$name};
  102   Value::Error("No definition for function '$name'") unless defined($fn);
  103   my $isFormula = 0;
  104   foreach my $x (@_) {return $self->formula($name,@_) if Value::isFormula($x)}
  105   my $class = $fn->{class};
  106   $class->_call($name,@_);
  107 }
  108 #
  109 #  Stub for sub-classes.
  110 #  (Default is return the argument)
  111 #
  112 sub _call {shift; shift; shift}
  113 
  114 #
  115 #  Create a formula that consists of a function call on the
  116 #    given arguments.  They are converted to formulas as well.
  117 #
  118 sub formula {
  119   my $self = shift; my $name = shift;
  120   my $formula = Value::Formula->blank;
  121   my @args = Value::toFormula($formula,@_);
  122   $formula->{tree} = $formula->{context}{parser}{Function}->new($formula,$name,[@args]);
  123   return $formula->eval if scalar(%{$formula->{variables}}) == 0;
  124   return $formula;
  125 }
  126 
  127 ##################################################
  128 #
  129 #  Service routines for checking the arguments
  130 #
  131 
  132 #
  133 #  Check that the function has a single numeric argument
  134 #    and check if it is allowed to be complex.
  135 #
  136 sub checkNumeric {
  137   my $self = shift;
  138   return if ($self->checkArgCount(1));
  139   my $arg = $self->{params}->[0];
  140   if ($arg->isComplex) {
  141     if (!($self->{def}{nocomplex})) {$self->{type} = $Value::Type{complex}}
  142     else {$self->Error("Function '$self->{name}' doesn't accept Complex inputs")}
  143   } elsif ($arg->isNumber) {
  144     $self->{type} = $Value::Type{number};
  145   } else {$self->Error("The input for '$self->{name}' must be a number")}
  146 }
  147 
  148 #
  149 #  Error if the argument is not a single vector
  150 #
  151 sub checkVector {
  152   my $self = shift;
  153   return if ($self->checkArgCount(1));
  154   if ($self->{params}->[0]->type =~ m/Point|Vector/) {
  155     $self->{type} = $Value::Type{number};
  156   } else {$self->Error("Function '$self->{name}' requires a Vector input")}
  157 }
  158 
  159 #
  160 #  Error if the argument isn't a single complex number
  161 #    and return a real.
  162 #
  163 sub checkReal {
  164   my $self = shift;
  165   return if ($self->checkArgCount(1));
  166   if ($self->{params}->[0]->isNumber) {
  167     $self->{type} = $Value::Type{number};
  168   } else {$self->Error("Function '$self->{name}' requires a Complex input")}
  169 }
  170 
  171 #
  172 #  Error if the argument isn't a singe complex number
  173 #    and return a complex.
  174 #
  175 sub checkComplex {
  176   my $self = shift;
  177   return if ($self->checkArgCount(1));
  178   if ($self->{params}->[0]->isNumber) {
  179     $self->{type} = $Value::Type{complex};
  180   } else {$self->Error("Function '$self->{name}' requires a Complex input")}
  181 }
  182 
  183 ##################################################
  184 #
  185 #  Service routines for arguments
  186 #
  187 
  188 #
  189 #  Check if the function's inverse can be written f^{-1}
  190 #
  191 sub checkInverse {
  192   my $equation = shift;
  193   my $fn = shift; my $op = shift; my $rop = shift;
  194   $op = $equation->{context}{operators}{$op->{name}};
  195   $fn = $equation->{context}{functions}{$fn->{name}};
  196   return ($fn->{inverse} && $op->{isInverse} && $rop->{value}->string eq "-1");
  197 }
  198 
  199 #
  200 #  Check that there are the right number of arguments
  201 #
  202 sub checkArgCount {
  203   my $self = shift; my $count = shift;
  204   my $name = $self->{name};
  205   my $args = scalar(@{$self->{params}});
  206   if ($args == $count) {
  207     return 0 if ($count == 0 || $self->{params}->[0]->length > 0);
  208     $self->Error("Function '$name' requires a non-empty input list");
  209   } elsif ($args < $count) {
  210     $self->Error("Function '$name' has too few inputs");
  211   } else {
  212     $self->Error("Function '$name' has too many inputs");
  213   }
  214   return 1;
  215 }
  216 
  217 #
  218 #  Find all the variables used in the arguments
  219 #
  220 sub getVariables {
  221   my $self = shift; my $vars = {};
  222   foreach my $x (@{$self->{params}}) {$vars = {%{$vars},%{$x->getVariables}}}
  223   return $vars;
  224 }
  225 
  226 ##################################################
  227 #
  228 #  Generate the different output formats
  229 #
  230 
  231 #
  232 #  Produce the string form.
  233 #
  234 #  Put parentheses around the funciton call if
  235 #    the function call is on the left of the parent operation
  236 #    and the precedence of the parent is higher than function call
  237 #    (e.g., powers, etc.)
  238 #
  239 sub string {
  240   my ($self,$precedence,$showparens,$position,$outerRight,$power) = @_;
  241   my $string; my $fn = $self->{equation}{context}{operators}{'fn'};
  242   my @pstr = (); my $fn_precedence = $fn->{precedence};
  243   $fn_precedence = $fn->{parenPrecedence}
  244     if ($position && $position eq 'right' && $fn->{parenPrecedence});
  245   foreach my $x (@{$self->{params}}) {push(@pstr,$x->string)}
  246   $string = ($self->{def}{string} || $self->{name})."$power".'('.join(',',@pstr).')';
  247   $string = '('.$string.')'
  248     if (defined($precedence) and $precedence > $fn_precedence);
  249   return $string;
  250 }
  251 
  252 #
  253 #  Produce the TeX form.
  254 #
  255 sub TeX {
  256   my ($self,$precedence,$showparens,$position,$outerRight,$power) = @_;
  257   my $TeX; my $fn = $self->{equation}{context}{operators}{'fn'};
  258   my @pstr = (); my $fn_precedence = $fn->{precedence};
  259   $fn_precedence = $fn->{parenPrecedence}
  260     if ($position && $position eq 'right' && $fn->{parenPrecedence});
  261   $fn = $self->{def};
  262   my $name = '\mathop{\rm '.$self->{name}.'}';
  263   $name = $fn->{TeX} if defined($fn->{TeX});
  264   foreach my $x (@{$self->{params}}) {push(@pstr,$x->TeX)}
  265   if ($fn->{braceTeX}) {$TeX = $name.'{'.join(',',@pstr).'}'}
  266     else {$TeX = $name."$power".'\left('.join(',',@pstr).'\right)'}
  267   $TeX = '\left('.$TeX.'\right)'
  268     if (defined($precedence) and $precedence > $fn_precedence);
  269   return $TeX;
  270 }
  271 
  272 #
  273 #  Produce the perl form.
  274 #
  275 sub perl {
  276   my $self = shift; my $parens = shift;
  277   my $fn = $self->{def}; my @p = ();
  278   foreach my $x (@{$self->{params}}) {push(@p,$x->perl)}
  279   my $perl = ($fn->{perl}? $fn->{perl} : $self->{name}).'('.join(',',@p).')';
  280   $perl = '('.$perl.')' if $parens == 1;
  281   return $perl;
  282 }
  283 
  284 #########################################################################
  285 #
  286 #  Load the subclasses.
  287 #
  288 
  289 use Parser::Function::undefined;
  290 use Parser::Function::trig;
  291 use Parser::Function::hyperbolic;
  292 use Parser::Function::numeric;
  293 use Parser::Function::numeric2;
  294 use Parser::Function::complex;
  295 use Parser::Function::vector;
  296 
  297 #########################################################################
  298 
  299 1;
  300 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9