[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 2558 - (download) (as text) (annotate)
Wed Jul 28 20:32:33 2004 UTC (15 years, 6 months ago) by sh002i
File size: 8345 byte(s)
merged changes from rel-2-1-a1 -- stop using that branch.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9