[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 5753 - (download) (as text) (annotate)
Tue Jun 24 21:30:38 2008 UTC (11 years, 8 months ago) by gage
File size: 5592 byte(s)
formatting changes

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9