version 1.18, 2010/10/30 02:31:27
|
version 1.21, 2010/10/31 12:33:02
|
Line 503 sub d2dt2_cubic_hermite {
|
Line 503 sub d2dt2_cubic_hermite {
|
# |
# |
sub array_index { |
sub array_index { |
my ($xmin,$xmax,$x)=@_; |
my ($xmin,$xmax,$x)=@_; |
my $index=int(($x-$xmin)/($xmax-$xmin)*200.+0.5); |
return int(($x-$xmin)/($xmax-$xmin)*200.+0.5); |
return $index; |
} |
|
|
|
# |
|
# 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); |
|
&Apache::lonnet::logthis("x:$x i:$i xr:$xr"); |
|
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; } |
|
my $func=$fl+$factor*($fh-$fl); |
|
&Apache::lonnet::logthis("x:$x func:$func factor:$factor il:$il ih:$ih fil:$fl fih:$fh"); |
|
return $func; |
} |
} |
|
|
# |
# |
Line 514 sub array_index {
|
Line 565 sub array_index {
|
sub populate_arrays { |
sub populate_arrays { |
my ($id,$xmin,$xmax)=@_; |
my ($id,$xmin,$xmax)=@_; |
for (my $i=0; $i<=200; $i++) { |
for (my $i=0; $i<=200; $i++) { |
undef $Apache::functionplotresponse::func[$i]; |
$Apache::functionplotresponse::func[$i]=undef; |
undef $Apache::functionplotresponse::dfunddx[$i]; |
$Apache::functionplotresponse::dfunddx[$i]=undef; |
undef $Apache::functionplotresponse::d2funcd2x[$i]; |
$Apache::functionplotresponse::d2funcd2x[$i]=undef; |
} |
} |
unless ($xmax>$xmin) { return; } |
unless ($xmax>$xmin) { return 'no_func'; } |
# Run over all splines in response |
# Run over all splines in response |
foreach my $label (split(/\,/,$env{"form.HWVAL_AllSplines_$id"})) { |
foreach my $label (split(/\,/,$env{"form.HWVAL_AllSplines_$id"})) { |
|
my $xiold=-1; |
# Run over all points in spline |
# Run over all points in spline |
for (my $i=0; $i<$env{"form.HWVAL_SplineOrder_".$id."_".$label}; $i++) { |
for (my $i=1; $i<$env{"form.HWVAL_SplineOrder_".$id."_".$label}; $i++) { |
my $xiold=-1; |
|
my $ni=$i+1; |
my $ni=$i+1; |
my @xparms=($env{'form.HWVAL_'.$id.'_'.$label.'P'.$i.'_x'}, |
my @xparms=($env{'form.HWVAL_'.$id.'_'.$label.'P'.$i.'_x'}, |
$env{'form.HWVAL_'.$id.'_'.$label.'S'.$i.'_x'}, |
$env{'form.HWVAL_'.$id.'_'.$label.'S'.$i.'_x'}, |
Line 533 sub populate_arrays {
|
Line 584 sub populate_arrays {
|
$env{'form.HWVAL_'.$id.'_'.$label.'S'.$i.'_y'}, |
$env{'form.HWVAL_'.$id.'_'.$label.'S'.$i.'_y'}, |
$env{'form.HWVAL_'.$id.'_'.$label.'P'.$ni.'_y'}, |
$env{'form.HWVAL_'.$id.'_'.$label.'P'.$ni.'_y'}, |
$env{'form.HWVAL_'.$id.'_'.$label.'S'.$ni.'_y'}); |
$env{'form.HWVAL_'.$id.'_'.$label.'S'.$ni.'_y'}); |
|
|
# Run in small steps over spline parameter |
# Run in small steps over spline parameter |
for (my $t=0; $t<=1; $t+=0.00025) { |
for (my $t=0; $t<=1; $t+=0.00025) { |
my $xi=&array_index($xmin,$xmax,&cubic_hermite($t,@xparms)); |
my $xi=&array_index($xmin,$xmax,&cubic_hermite($t,@xparms)); |
if ($xi<$xiold-5) { return 'no_func'; } |
if ($xi<$xiold) { return 'no_func'; } |
if ($xi>$xiold) { |
if (($xi>$xiold) && ($xi>=0) && ($xi<=200)) { |
|
if (defined($Apache::functionplotresponse::func[$xi])) { return 'no_func'; } |
$xiold=$xi; |
$xiold=$xi; |
$Apache::functionplotresponse::func[$xi]=&cubic_hermite($t,@yparms); |
$Apache::functionplotresponse::func[$xi]=&cubic_hermite($t,@yparms); |
} |
} |
Line 667 sub end_functionplotresponse {
|
Line 718 sub end_functionplotresponse {
|
$xmax=(defined($xmax)?$xmax:10); |
$xmax=(defined($xmax)?$xmax:10); |
my $ad; |
my $ad; |
if (&populate_arrays($internalid,$xmin,$xmax) eq 'no_func') { |
if (&populate_arrays($internalid,$xmin,$xmax) eq 'no_func') { |
$ad='BAD_FORMULA'; |
$ad='NOT_FUNCTION'; |
} else { |
} else { |
$ad='INCORRECT'; |
$ad='INCORRECT'; |
} |
} |
|
&func_val($xmin,$xmax,3.96); |
|
|
|
&func_val($xmin,$xmax,3.965); |
|
|
|
&func_val($xmin,$xmax,3.97); |
|
&func_val($xmin,$xmax,3.975); |
|
&func_val($xmin,$xmax,3.98); |
|
|
|
&func_val($xmin,$xmax,3.985); |
|
&func_val($xmin,$xmax,3.99); |
|
&func_val($xmin,$xmax,3.995); |
|
|
|
&func_val($xmin,$xmax,4); |
|
&func_val($xmin,$xmax,4.05); |
|
&func_val($xmin,$xmax,4.1); |
|
|
|
&func_val($xmin,$xmax,4.15); |
|
&func_val($xmin,$xmax,4.2); |
|
&func_val($xmin,$xmax,4.25); |
|
|
# |
# |
# Store grading info |
# Store grading info |
# |
# |