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

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