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

    1 
    2 loadMacros('MathObjects.pl');
    3 
    4 sub _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 sub parserFunction {parserFunction->Create(@_)}
   41 
   42 #
   43 #  The package that will manage user-defined functions
   44 #
   45 package parserFunction;
   46 our @ISA = qw(Parser::Function);
   47 
   48 sub Create {
   49   my $self = shift; my $name = shift; my $formula = shift;
   50   my $context = (Value::isContext($_[0]) ? shift : Value->context);
   51   my @argNames; my @argTypes; my @newVars;
   52   #
   53   #  Look for argument names for the function
   54   #   (check that the arguments are ok, and temporarily
   55   #    add in any variables that are not already there)
   56   #
   57   if ($name =~ m/^([a-z0-9]+)\(\s*(.*?)\s*\)$/i) {
   58     $name = $1; my $args = $2;
   59     @argNames = split(/\s*,\s*/,$args);
   60     foreach my $x (@argNames) {
   61       Value::Error("Illegal variable name '%s'",$x) if $x =~ m/[^a-z]/i;
   62       unless ($context->{variables}{$x}) {
   63   $context->variables->add($x=>'Real');
   64   push(@newVars,$x);
   65       }
   66     }
   67   } else {
   68     Value::Error("Illegal function name '%s'",$name)
   69       if $name =~ m/[^a-z0-9]/i;
   70   }
   71   #
   72   #  Create the formula and get its arguments and types
   73   #
   74   $formula = $context->Package("Formula")->new($context,$formula) unless Value::isFormula($formula);
   75   @argNames = main::lex_sort(keys(%{$formula->{variables}})) unless scalar(@argNames);
   76   foreach my $x (@argNames) {push(@argTypes,$context->{variables}{$x}{type})}
   77   #
   78   #  Add the function to the context and create the perl function
   79   #
   80   $context->functions->add(
   81     $name => {
   82       (length($name) == 1? (TeX=>$name): ()),
   83       @_, class => 'parserFunction', argCount => scalar(@argNames),
   84       argNames => [@argNames], argTypes => [@argTypes],
   85       function => $formula->perlFunction(undef,[@argNames]),
   86       formula => $formula, type => $formula->typeRef,
   87     }
   88   );
   89   main::PG_restricted_eval("sub main::$name {Parser::Function->call('$name',\@_)}");
   90   $context->variables->remove(@newVars) if scalar(@newVars);
   91 }
   92 
   93 #
   94 #  Check that there are the right number of arguments
   95 #  and they are of the right type.
   96 #
   97 sub _check {
   98   my $self = shift; my $name = $self->{name};
   99   return if $self->checkArgCount($self->{def}{argCount});
  100   my @argTypes = @{$self->{def}{argTypes}}; my $n = 0;
  101   foreach my $x (@{$self->{params}}) {
  102     my $atype = shift(@argTypes); $n++;
  103     $self->Error("The %s argument for '%s' should be of type %s",
  104      NameForNumber($n),$name,$atype->{name})
  105       unless (Parser::Item::typeMatch($atype,$x->{type}));
  106   }
  107   $self->{type} = $self->{def}{type};
  108 }
  109 
  110 #
  111 #  Call the function stored in the definition
  112 #
  113 sub _eval {
  114   my $self = shift; my $name = $self->{name};
  115   &{$self->{def}{function}}(@_);
  116 }
  117 
  118 #
  119 #  Check the arguments and compute the result.
  120 #
  121 sub _call {
  122   my $self = shift; my $name = shift;
  123   my $def = Value->context->{functions}{$name};
  124   &{$def->{function}}(@_);
  125 }
  126 
  127 =head3 ($Function)->D
  128 
  129 #
  130 #  Compute the derivative of (single-variable) functions
  131 #    using the chain rule.
  132 #
  133 
  134 =cut
  135 
  136 sub D {
  137   my $self = shift; my $def = $self->{def};
  138   $self->Error("Can't differentiate function '%s'",$self->{name})
  139     unless $def->{argCount} == 1;
  140   my $x = $def->{argNames}[0];
  141   my $Df = $def->{formula}->D($x);
  142   my $g = $self->{params}[0];
  143   return (($Df->substitute($x=>$g))*($g->D(@_)))->{tree}->reduce;
  144 }
  145 
  146 =head3 NameForNumber($number)
  147 
  148 #
  149 #  Get the name for a number
  150 #
  151 
  152 =cut
  153 
  154 sub NameForNumber {
  155   my $n = shift;
  156   my $name =  ('zeroth','first','second','third','fourth','fifth',
  157                'sixth','seventh','eighth','ninth','tenth')[$n];
  158   $name = "$n-th" if ($n > 10);
  159   return $name;
  160 }
  161 
  162 1;