Parent Directory
| 
Revision Log
Revision 4727 - (view) (download) (as text)
| 1 : | dpvc | 3375 | 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 : | dpvc | 4727 | # samples.) |
| 11 : | dpvc | 3375 | # |
| 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 : | dpvc | 3501 | formula => $formula, type => $formula->typeRef, |
| 82 : | dpvc | 3375 | } |
| 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 : | dpvc | 3501 | # 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 : | dpvc | 3375 | # 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; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |