--- loncom/homework/functionplotresponse.pm 2010/10/28 00:27:56 1.16 +++ loncom/homework/functionplotresponse.pm 2010/11/06 16:12:39 1.24 @@ -1,7 +1,7 @@ # LearningOnline Network with CAPA # option list style responses # -# $Id: functionplotresponse.pm,v 1.16 2010/10/28 00:27:56 www Exp $ +# $Id: functionplotresponse.pm,v 1.24 2010/11/06 16:12:39 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -107,7 +107,7 @@ sub init_script { $script.="if (param=='applet_$id') { loaded_$id=true; }\n"; } $script.="if (".join(' && ',map { "loaded_$_" } (@Apache::functionplotresponse::callscripts)). - ") { setTimeout('ggbInitAll()',20) }\n"; + ") { setTimeout('ggbInitAll()',20) }"; my $calls=join("\n",map { "ggbInit_$_();" } (@Apache::functionplotresponse::callscripts)); return (< @@ -119,7 +119,7 @@ function ggbOnInit(param) { $script } function ggbInitAll() { -$calls; +$calls } // ]]> @@ -344,10 +344,56 @@ sub end_backgroundplot { sub start_splinerule { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - my $internalid = $Apache::inputtags::part.'_'.$Apache::inputtags::response[-1]; - if ($target eq 'edit') { - $result=&Apache::edit::tag_start($target,$token,'Spline Evaluation Rule'). - &Apache::edit::end_row(); + my $label=&Apache::lonxml::get_param('index',$parstack,$safeeval); + $Apache::functionplotresponse::counter++; + if ($label=~/\W/) { + &Apache::lonxml::warning(&mt('Spline Rule indices should only contain alphanumeric characters.')); + } + $label=~s/\W//gs; + unless ($label) { + $label='R'.$Apache::functionplotresponse::counter; + } else { + $label='R'.$label; + } + if ($Apache::functionplotresponse::splineorder{$label}) { + &Apache::lonxml::error(&mt('Spline Rule indices must be unique.')); + } + + + if ($target eq 'grade') { +# Simply remember - in order - for later + my $beginninglabel=&Apache::lonxml::get_param('beginninglabel',$parstack,$safeeval); + my $endinglabel=&Apache::lonxml::get_param('endinglabel',$parstack,$safeeval); + if (($beginninglabel=~/\W/) || ($endinglabel=~/W/)) { + &Apache::lonxml::warning(&mt('Spline Rule labels must be alphanumeric.')); + } + $beginninglabel=~s/\W//gs; + $endinglabel=~s/\W//gs; + my $relationship=&Apache::lonxml::get_param('relationship',$parstack,$safeeval); + $relationship=~s/\W//gs; + $relationship=lc($relationship); + unless ($relationship=~/^(eq|ge|gt|le|lt|ne)$/) { + &Apache::lonxml::warning(&mt('Spline Rule relationship not defined.')); + $relationship='eq'; + } + my $derivative=&Apache::lonxml::get_param('derivative',$parstack,$safeeval); + unless (($derivative==0) || ($derivative==1) || ($derivative==2)) { + &Apache::lonxml::warning(&mt('Spline Rule derivative not defined.')); + $derivative=0; + } + push(@Apache::functionplotresponse::splinerules,join(':',( + $label, + $derivative, + &Apache::lonxml::get_param('beginningvalue',$parstack,$safeeval), + $beginninglabel, + &Apache::lonxml::get_param('endingvalue',$parstack,$safeeval), + $endinglabel, + $relationship, + &Apache::lonxml::get_param('value',$parstack,$safeeval) + ))); + } elsif ($target eq 'edit') { + $result=&Apache::edit::tag_start($target,$token,'Spline Evaluation Rule'). + &Apache::edit::end_row(); } return $result; } @@ -363,7 +409,7 @@ sub end_splinerule { # -# +# # # Unfortunately, GeoGebra seems to want all splines after everything else, so we need to store them # @@ -371,15 +417,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 +454,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 +469,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); } } @@ -499,6 +549,144 @@ sub d2dt2_cubic_hermite { } # +# Array index calculation +# +sub array_index { + my ($xmin,$xmax,$x)=@_; + 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); +} + +# +# Populate the arrays +# + +sub populate_arrays { + my ($id,$xmin,$xmax)=@_; + for (my $i=0; $i<=200; $i++) { + $Apache::functionplotresponse::func[$i]=undef; + $Apache::functionplotresponse::dfuncdx[$i]=undef; + $Apache::functionplotresponse::d2funcd2x[$i]=undef; + } + unless ($xmax>$xmin) { return 'no_func'; } +# Run over all splines in response + foreach my $label (split(/\,/,$env{"form.HWVAL_AllSplines_$id"})) { + my $xiold=-1; +# Run over all points in spline + for (my $i=1; $i<$env{"form.HWVAL_SplineOrder_".$id."_".$label}; $i++) { + my $ni=$i+1; + my @xparms=($env{'form.HWVAL_'.$id.'_'.$label.'P'.$i.'_x'}, + $env{'form.HWVAL_'.$id.'_'.$label.'S'.$i.'_x'}, + $env{'form.HWVAL_'.$id.'_'.$label.'P'.$ni.'_x'}, + $env{'form.HWVAL_'.$id.'_'.$label.'S'.$ni.'_x'}); + my @yparms=($env{'form.HWVAL_'.$id.'_'.$label.'P'.$i.'_y'}, + $env{'form.HWVAL_'.$id.'_'.$label.'S'.$i.'_y'}, + $env{'form.HWVAL_'.$id.'_'.$label.'P'.$ni.'_y'}, + $env{'form.HWVAL_'.$id.'_'.$label.'S'.$ni.'_y'}); +# Run in small steps over spline parameter + for (my $t=0; $t<=1; $t+=0.00025) { + my $xi=&array_index($xmin,$xmax,&cubic_hermite($t,@xparms)); + if ($xi<$xiold) { return 'no_func'; } + 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; + } + } + } + } + } +} + +# # Implentation of # @@ -515,6 +703,8 @@ sub start_functionplotresponse { undef %Apache::functionplotresponse::previous; $Apache::functionplotresponse::inputfields=''; $Apache::functionplotresponse::counter=0; +# Remember rules + undef @Apache::functionplotresponse::splinerules; # Part and ID my $partid=$Apache::inputtags::part; my $id=&Apache::response::start_response($parstack,$safeeval); @@ -525,13 +715,13 @@ sub start_functionplotresponse { # Parameters of my $xmin=&Apache::lonxml::get_param('xmin',$parstack,$safeeval); - $xmin=($xmin?$xmin:-10); + $xmin=(defined($xmin)?$xmin:-10); my $xmax=&Apache::lonxml::get_param('xmax',$parstack,$safeeval); - $xmax=($xmax?$xmax:10); + $xmax=(defined($xmax)?$xmax:10); my $ymin=&Apache::lonxml::get_param('ymin',$parstack,$safeeval); - $ymin=($ymin?$ymin:-10); + $ymin=(defined($ymin)?$ymin:-10); my $ymax=&Apache::lonxml::get_param('ymax',$parstack,$safeeval); - $ymax=($ymax?$ymax:10); + $ymax=(defined($ymax)?$ymax:10); my $xaxisvisible=(&Apache::lonxml::get_param('xaxisvisible',$parstack,$safeeval)=~/on|true|yes|1/i?'true':'false'); my $yaxisvisible=(&Apache::lonxml::get_param('yaxisvisible',$parstack,$safeeval)=~/on|true|yes|1/i?'true':'false'); my $gridvisible=(&Apache::lonxml::get_param('gridvisible',$parstack,$safeeval)=~/on|true|yes|1/i?'true':'false'); @@ -587,6 +777,12 @@ sub start_functionplotresponse { return $result; } +sub splinerulecheck { + my ($rule)=@_; + return 0; +} + + sub end_functionplotresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; &Apache::response::end_response; @@ -612,7 +808,26 @@ sub end_functionplotresponse { # # Actually grade # - my $ad='INCORRECT'; + my $xmin=&Apache::lonxml::get_param('xmin',$parstack,$safeeval); + $xmin=(defined($xmin)?$xmin:-10); + my $xmax=&Apache::lonxml::get_param('xmax',$parstack,$safeeval); + $xmax=(defined($xmax)?$xmax:10); + my $ad=''; + if (&populate_arrays($internalid,$xmin,$xmax) eq 'no_func') { + $ad='NOT_FUNCTION'; + } else { +# We have a function that we can actually grade, go through the spline rules. + undef %Apache::functionplotresponse::splinerulelabels; + foreach my $rule (@Apache::functionplotresponse::splinerules) { + unless (&splinerulecheck($rule)) { + $ad='INCORRECT'; + last; + } + } +# If it's not wrong, it's correct + unless ($ad) { $ad='EXACT_ANS' }; + } + # # Store grading info # @@ -625,6 +840,13 @@ sub end_functionplotresponse { } # close the init script $result.=&end_init_script(); +# register all splines in this response + $result.=''."\n"; + foreach my $label (keys(%Apache::functionplotresponse::splineorder)) { + $result.=''."\n"; + } # generate the input fields $result.=$Apache::functionplotresponse::inputfields; # actually start the -tag