[LON-CAPA-cvs] cvs: loncom /homework functionplotresponse.pm
www
www@source.lon-capa.org
Sun, 07 Nov 2010 11:15:38 -0000
www Sun Nov 7 11:15:38 2010 EDT
Modified files:
/loncom/homework functionplotresponse.pm
Log:
Simpler is better: more precision, less interpolation.
Implement gt, lt, etc
Deal with undef as desired value
Index: loncom/homework/functionplotresponse.pm
diff -u loncom/homework/functionplotresponse.pm:1.25 loncom/homework/functionplotresponse.pm:1.26
--- loncom/homework/functionplotresponse.pm:1.25 Sun Nov 7 01:57:50 2010
+++ loncom/homework/functionplotresponse.pm Sun Nov 7 11:15:37 2010
@@ -1,7 +1,7 @@
# LearningOnline Network with CAPA
# option list style responses
#
-# $Id: functionplotresponse.pm,v 1.25 2010/11/07 01:57:50 www Exp $
+# $Id: functionplotresponse.pm,v 1.26 2010/11/07 11:15:37 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -553,7 +553,7 @@
#
sub array_index {
my ($xmin,$xmax,$x)=@_;
- return int(($x-$xmin)/($xmax-$xmin)*200.+0.5);
+ return int(($x-$xmin)/($xmax-$xmin)*400.+0.5);
}
#
@@ -562,32 +562,7 @@
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);
- }
+ return $i*($xmax-$xmin)/400.+$xmin;
}
#
@@ -596,13 +571,7 @@
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);
+ return $Apache::functionplotresponse::func[&array_index($xmin,$xmax,$x)];
}
#
@@ -611,13 +580,7 @@
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);
+ return $Apache::functionplotresponse::dfuncdx[&array_index($xmin,$xmax,$x)];
}
#
@@ -626,13 +589,7 @@
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);
+ return $Apache::functionplotresponse::d2funcdx2[&array_index($xmin,$xmax,$x)];
}
#
@@ -641,7 +598,7 @@
sub populate_arrays {
my ($id,$xmin,$xmax)=@_;
- for (my $i=0; $i<=200; $i++) {
+ for (my $i=0; $i<=400; $i++) {
$Apache::functionplotresponse::func[$i]=undef;
$Apache::functionplotresponse::dfuncdx[$i]=undef;
$Apache::functionplotresponse::d2funcd2x[$i]=undef;
@@ -662,10 +619,10 @@
$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) {
+ for (my $t=0; $t<=1; $t+=0.0001) {
my $xi=&array_index($xmin,$xmax,&cubic_hermite($t,@xparms));
if ($xi<$xiold) { return 'no_func'; }
- if (($xi>$xiold) && ($xi>=0) && ($xi<=200)) {
+ if (($xi>$xiold) && ($xi>=0) && ($xi<=400)) {
if (defined($Apache::functionplotresponse::func[$xi])) { return 'no_func'; }
$xiold=$xi;
# Function value
@@ -786,8 +743,40 @@
}
sub compare_rel {
- my ($relationship,$value,$val,$tol)=@_;
- if (abs($value-$val)<$tol) { return 1; }
+ my ($relationship,$value,$realval,$tol)=@_;
+# is the real value defined?
+ unless (defined($realval)) {
+ if ($relationship eq 'eq') {
+ if ($value eq 'undef') {
+ return 1;
+ } else {
+ return 0;
+ }
+ } elsif ($relationship eq 'ne') {
+ if ($value eq 'undef') {
+ return 0;
+ } else {
+ return 1;
+ }
+ } else {
+ return 0;
+ }
+ }
+
+# it is defined.
+ if ($relationship eq 'gt') {
+ return ($realval>$value);
+ } elsif ($relationship eq 'ge') {
+ return ($realval>$value-$tol);
+ } elsif ($relationship eq 'lt') {
+ return ($realval<$value);
+ } elsif ($relationship eq 'le') {
+ return ($realval<$value+$tol);
+ } elsif ($relationship eq 'ne') {
+ return (abs($value-$realval)>$tol);
+ } else {
+ return (abs($value-$realval)<$tol);
+ }
return 0;
}
@@ -876,7 +865,7 @@
$ymin=(defined($ymin)?$ymin:-10);
my $ymax=&Apache::lonxml::get_param('ymax',$parstack,$safeeval);
$ymax=(defined($ymax)?$ymax:10);
- my $tolfunc=($ymax-$ymin)/100.;
+ my $tolfunc=5.*($ymax-$ymin)/100.;
my $toldfdx=1;
my $told2fdx2=1;
if ($xmax>$xmin) {