--- loncom/homework/functionplotresponse.pm 2010/10/30 15:32:36 1.19 +++ loncom/homework/functionplotresponse.pm 2010/11/01 00:04:09 1.22 @@ -1,7 +1,7 @@ # LearningOnline Network with CAPA # option list style responses # -# $Id: functionplotresponse.pm,v 1.19 2010/10/30 15:32:36 www Exp $ +# $Id: functionplotresponse.pm,v 1.22 2010/11/01 00:04:09 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -503,8 +503,86 @@ sub d2dt2_cubic_hermite { # sub array_index { my ($xmin,$xmax,$x)=@_; - my $index=int(($x-$xmin)/($xmax-$xmin)*200.+0.5); - return $index; + return int(($x-$xmin)/($xmax-$xmin)*200.+0.5); +} + +# +# Actual x-value of array index +# + +sub index_x { + my ($xmin,$xmax,$i)=@_; + return $i*($xmax-$xmin)/200.+$xmin; +} + +# +# Assume function to be linear between array points +# Return the two indices and the scale factor +# + +sub indices_scale { + my ($xmin,$xmax,$x)=@_; + my $i=&array_index($xmin,$xmax,$x); + my $xr=&index_x($xmin,$xmax,$i); + if ($xr<$x) { +# Desired x is right of array index + if ($i>=200) { return (200,200,0); } + return($i,$i+1,200.*($x-$xr)/($xmax-$xmin)); + } elsif ($xr>$x) { +# Desired x is left of array index + if ($i<=0) { return (0,0,0); } + return($i-1,$i,1.-200.*($xr-$x)/($xmax-$xmin)); + } else { +# Desired x is at array index (unlikely, but ...) + if ($i>=200) { return (200,200,0); } + if ($i<=0) { return (0,0,0); } + return ($i,$i,0); + } +} + +# +# Function value +# + +sub func_val { + my ($xmin,$xmax,$x)=@_; + my ($il,$ih,$factor)=&indices_scale($xmin,$xmax,$x); + my $fl=$Apache::functionplotresponse::func[$il]; + my $fh=$Apache::functionplotresponse::func[$ih]; + unless (defined($fl) || defined($fh)) { return undef; } + unless (defined($fl)) { return $fh; } + unless (defined($fh)) { return $fl; } + return $fl+$factor*($fh-$fl); +} + +# +# First derivative +# + +sub dfuncdx_val { + my ($xmin,$xmax,$x)=@_; + my ($il,$ih,$factor)=&indices_scale($xmin,$xmax,$x); + my $fl=$Apache::functionplotresponse::dfuncdx[$il]; + my $fh=$Apache::functionplotresponse::dfuncdx[$ih]; + unless (defined($fl) || defined($fh)) { return undef; } + unless (defined($fl)) { return $fh; } + unless (defined($fh)) { return $fl; } + return $fl+$factor*($fh-$fl); +} + +# +# Second derivative +# + +sub d2funcdx2_val { + my ($xmin,$xmax,$x)=@_; + my ($il,$ih,$factor)=&indices_scale($xmin,$xmax,$x); + my $fl=$Apache::functionplotresponse::d2funcdx2[$il]; + my $fh=$Apache::functionplotresponse::d2funcdx2[$ih]; + unless (defined($fl) || defined($fh)) { return undef; } + unless (defined($fl)) { return $fh; } + unless (defined($fh)) { return $fl; } + return $fl+$factor*($fh-$fl); } # @@ -515,7 +593,7 @@ sub populate_arrays { my ($id,$xmin,$xmax)=@_; for (my $i=0; $i<=200; $i++) { $Apache::functionplotresponse::func[$i]=undef; - $Apache::functionplotresponse::dfunddx[$i]=undef; + $Apache::functionplotresponse::dfuncdx[$i]=undef; $Apache::functionplotresponse::d2funcd2x[$i]=undef; } unless ($xmax>$xmin) { return 'no_func'; } @@ -540,7 +618,18 @@ sub populate_arrays { if (($xi>$xiold) && ($xi>=0) && ($xi<=200)) { if (defined($Apache::functionplotresponse::func[$xi])) { return 'no_func'; } $xiold=$xi; +# Function value $Apache::functionplotresponse::func[$xi]=&cubic_hermite($t,@yparms); +# dy/dx=dy/dt/(dx/dt) + my $dxdt=&ddt_cubic_hermite($t,@xparms); + if ($dxdt) { + $Apache::functionplotresponse::dfuncdx[$xi]=&ddt_cubic_hermite($t,@yparms)/$dxdt; + } +# d^2y/dx^2 + my $d2xdt2=&d2dt2_cubic_hermite($t,@xparms); + if ($d2xdt2) { + $Apache::functionplotresponse::d2funcd2x[$xi]=&d2dt2_cubic_hermite($t,@yparms)/$d2xdt2; + } } } } @@ -667,10 +756,11 @@ sub end_functionplotresponse { $xmax=(defined($xmax)?$xmax:10); my $ad; if (&populate_arrays($internalid,$xmin,$xmax) eq 'no_func') { - $ad='BAD_FORMULA'; + $ad='NOT_FUNCTION'; } else { $ad='INCORRECT'; } + # # Store grading info #