[system] / trunk / pg / macros / parserFunction.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/parserFunction.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5379 - (download) (as text) (annotate)
Sun Aug 19 14:54:35 2007 UTC (12 years, 6 months ago) by dpvc
File size: 4694 byte(s)
More fixes to POD sections.

    1 
    2 loadMacros('MathObjects.pl');
    3 
    4 sub _parserFunction_init {parserFunction::Init()}; # don't reload this file
    5 
    6 =head1 DESCRIPTION
    7 
    8  ####################################################################
    9  #
   10  #  This file implements an easy way of creating new functions that
   11  #  are added to the current Parser context.  (This avoids having to
   12  #  do the complicated procedure outlined in the docs/parser/extensions
   13  #  samples.)
   14  #
   15  #  To create a function that can be used in Formula() calls (and by
   16  #  students in their answers), use the parserFunction() routine, as
   17  #  in the following examples:
   18  #
   19  #     parserFunction(f => "sqrt(x+1)-2");
   20  #
   21  #     $x = Formula('x');
   22  #     parserFunction(f => sqrt($x+1)-2);
   23  #
   24  #     parserFunction("f(x)" => "sqrt(x+1)-2");
   25  #
   26  #     parserFunction("f(x,y)" => "sqrt(x*y)");
   27  #
   28  #  The first parameter to parserFunction is the name of the function
   29  #  or the name with its argument list.  In the first case, the
   30  #  names of the variables are taken from the formula for the
   31  #  function, and are listed in alphabetical order.
   32  #
   33  #  The second argument is the formula used to compute the value
   34  #  of the function.  It can be either a string or a Parser Formula
   35  #  object.
   36  #
   37 
   38 =cut
   39 
   40 #
   41 #  The package that will manage user-defined functions
   42 #
   43 package parserFunction;
   44 our @ISA = qw(Parser::Function);
   45 
   46 sub Init {
   47   main::PG_restricted_eval('sub parserFunction {parserFunction->Create(@_)}');
   48 }
   49 
   50 sub Create {
   51   my $self = shift; my $name = shift; my $formula = shift;
   52   my $context = (Value::isContext($_[0]) ? shift : Value->context);
   53   my @argNames; my @argTypes; my @newVars;
   54   #
   55   #  Look for argument names for the function
   56   #   (check that the arguments are ok, and temporarily
   57   #    add in any variables that are not already there)
   58   #
   59   if ($name =~ m/^([a-z0-9]+)\(\s*(.*?)\s*\)$/i) {
   60     $name = $1; my $args = $2;
   61     @argNames = split(/\s*,\s*/,$args);
   62     foreach my $x (@argNames) {
   63       Value::Error("Illegal variable name '%s'",$x) if $x =~ m/[^a-z]/i;
   64       unless ($context->{variables}{$x}) {
   65   $context->variables->add($x=>'Real');
   66   push(@newVars,$x);
   67       }
   68     }
   69   } else {
   70     Value::Error("Illegal function name '%s'",$name)
   71       if $name =~ m/[^a-z0-9]/i;
   72   }
   73   #
   74   #  Create the formula and get its arguments and types
   75   #
   76   $formula = $context->Package("Formula")->new($context,$formula) unless Value::isFormula($formula);
   77   @argNames = main::lex_sort(keys(%{$formula->{variables}})) unless scalar(@argNames);
   78   foreach my $x (@argNames) {push(@argTypes,$context->{variables}{$x}{type})}
   79   #
   80   #  Add the function to the context and create the perl function
   81   #
   82   $context->functions->add(
   83     $name => {
   84       (length($name) == 1? (TeX=>$name): ()),
   85       @_, class => 'parserFunction', argCount => scalar(@argNames),
   86       argNames => [@argNames], argTypes => [@argTypes],
   87       function => $formula->perlFunction(undef,[@argNames]),
   88       formula => $formula, type => $formula->typeRef,
   89     }
   90   );
   91   main::PG_restricted_eval("sub main::$name {Parser::Function->call('$name',\@_)}");
   92   $context->variables->remove(@newVars) if scalar(@newVars);
   93 }
   94 
   95 #
   96 #  Check that there are the right number of arguments
   97 #  and they are of the right type.
   98 #
   99 sub _check {
  100   my $self = shift; my $name = $self->{name};
  101   return if $self->checkArgCount($self->{def}{argCount});
  102   my @argTypes = @{$self->{def}{argTypes}}; my $n = 0;
  103   foreach my $x (@{$self->{params}}) {
  104     my $atype = shift(@argTypes); $n++;
  105     $self->Error("The %s argument for '%s' should be of type %s",
  106      NameForNumber($n),$name,$atype->{name})
  107       unless (Parser::Item::typeMatch($atype,$x->{type}));
  108   }
  109   $self->{type} = $self->{def}{type};
  110 }
  111 
  112 #
  113 #  Call the function stored in the definition
  114 #
  115 sub _eval {
  116   my $self = shift; my $name = $self->{name};
  117   &{$self->{def}{function}}(@_);
  118 }
  119 
  120 #
  121 #  Check the arguments and compute the result.
  122 #
  123 sub _call {
  124   my $self = shift; my $name = shift;
  125   my $def = Value->context->{functions}{$name};
  126   &{$def->{function}}(@_);
  127 }
  128 
  129 =head3 ($Function)->D
  130 
  131  #
  132  #  Compute the derivative of (single-variable) functions
  133  #    using the chain rule.
  134  #
  135 
  136 =cut
  137 
  138 sub D {
  139   my $self = shift; my $def = $self->{def};
  140   $self->Error("Can't differentiate function '%s'",$self->{name})
  141     unless $def->{argCount} == 1;
  142   my $x = $def->{argNames}[0];
  143   my $Df = $def->{formula}->D($x);
  144   my $g = $self->{params}[0];
  145   return (($Df->substitute($x=>$g))*($g->D(@_)))->{tree}->reduce;
  146 }
  147 
  148 #
  149 #  Get the name for a number
  150 #
  151 sub NameForNumber {
  152   my $n = shift;
  153   my $name =  ('zeroth','first','second','third','fourth','fifth',
  154                'sixth','seventh','eighth','ninth','tenth')[$n];
  155   $name = "$n-th" if ($n > 10);
  156   return $name;
  157 }
  158 
  159 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9