--- loncom/homework/functionplotresponse.pm 2010/10/30 15:32:36 1.19 +++ loncom/homework/functionplotresponse.pm 2010/11/06 14:37:24 1.23 @@ -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.23 2010/11/06 14:37:24 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -363,7 +363,7 @@ sub end_splinerule { # -# +# # # Unfortunately, GeoGebra seems to want all splines after everything else, so we need to store them # @@ -371,15 +371,19 @@ sub start_spline { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web') { - my $label=&Apache::lonxml::get_param('label',$parstack,$safeeval); + my $label=&Apache::lonxml::get_param('index',$parstack,$safeeval); $Apache::functionplotresponse::counter++; if ($label=~/\W/) { - &Apache::lonxml::warning(&mt('Spline labels should only contain alphanumeric characters.')); + &Apache::lonxml::warning(&mt('Spline indices should only contain alphanumeric characters.')); } $label=~s/\W//gs; - unless ($label) { $label='S'.$Apache::functionplotresponse::counter; } + unless ($label) { + $label='S'.$Apache::functionplotresponse::counter; + } else { + $label='S'.$label; + } if ($Apache::functionplotresponse::splineorder{$label}) { - &Apache::lonxml::error(&mt('Spline labels must be unique.')); + &Apache::lonxml::error(&mt('Spline indices must be unique.')); } my $order=&Apache::lonxml::get_param('order',$parstack,$safeeval); @@ -404,7 +408,7 @@ sub start_spline { $Apache::functionplotresponse::splinescaley{$label}=$sy; } elsif ($target eq 'edit') { $result=&Apache::edit::tag_start($target,$token,'Spline'). - &Apache::edit::text_arg('Label:','label', + &Apache::edit::text_arg('Index:','index', $token,'4').' '. &Apache::edit::select_arg('Order:','order', ['2','3','4','5','6','7','8','9'],$token).' '. @@ -419,7 +423,7 @@ sub start_spline { &Apache::edit::end_row(); } elsif ($target eq 'modified') { my $constructtag=&Apache::edit::get_new_args($token,$parstack, - $safeeval,'label','order','initx','inity', + $safeeval,'index','order','initx','inity', 'scalex','scaley'); if ($constructtag) { $result=&Apache::edit::rebuild_tag($token); } } @@ -503,8 +507,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 +597,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 +622,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 +760,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 #