version 1.31, 2001/07/19 21:26:22
|
version 1.39, 2001/10/29 21:15:44
|
Line 7
|
Line 7
|
# 05/31/2001 H. K. Ng |
# 05/31/2001 H. K. Ng |
# |
# |
#init some globals |
#init some globals |
$RANDOMINIT=0; |
$hidden::RANDOMINIT=0; |
$pi=atan2(1,1)*4; |
$pi=atan2(1,1)*4; |
$rad2deg=180.0/$pi; |
$rad2deg=180.0/$pi; |
$deg2rad=$pi/180.0; |
$deg2rad=$pi/180.0; |
|
|
sub caparesponse_check { |
sub caparesponse_check { |
my $answer=''; #done |
#not properly used yet: calc |
my $type=''; #done |
#not to be used: $ans_fmt |
|
my ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc,$samples) = |
|
eval $_[1]. |
|
';return ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc,$samples);'; |
|
|
my $tol_type=''; # gets it's value from whether tol has a % or not done |
my $tol_type=''; # gets it's value from whether tol has a % or not done |
my $tol=''; #done |
|
my $sig=''; #done lowerbnd,upperbnd |
|
my $sig_lbound=''; #done |
my $sig_lbound=''; #done |
my $sig_ubound=''; #done |
my $sig_ubound=''; #done |
my $ans_fmt=''; |
|
my $unit=''; #done |
|
my $calc=''; |
|
my ($response,$expr)=@_; |
my ($response,$expr)=@_; |
|
|
($answer,$type,$tol,$sig,$ans_fmt, |
|
$unit,$calc) = eval $expr.';return ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc);'; |
|
#type's definitons come from capaParser.h |
#type's definitons come from capaParser.h |
my $message=''; |
my $message=''; |
|
#remove leading and trailing whitespace |
|
if ($response=~ /^\s|\s$/) { |
|
$response=~ s:^\s+|\s+$::g; |
|
$message .="Removed ws now :$response:<br />"; |
|
} else { |
|
$message .="no ws in :$response:<br />"; |
|
} |
|
|
if ($type eq '' ) { |
if ($type eq '' ) { |
$message .= "Didn't find a type :$type:$expr: defaulting<br />"; |
$message .= "Didn't find a type :$type:$expr: defaulting<br />"; |
if ( $answer eq ($answer *1.0)) { $type = 2; |
if ( $answer eq ($answer *1.0)) { $type = 2; |
Line 42 sub caparesponse_check {
|
Line 48 sub caparesponse_check {
|
} else { return "ERROR: Unknown type of answer: $type" } |
} else { return "ERROR: Unknown type of answer: $type" } |
} |
} |
|
|
|
my $points; |
|
my $id_list; |
|
#formula type setup the sample points |
|
if ($type eq '8') { |
|
($id_list,$points)=split(/@/,$samples); |
|
$message.="Found :$points: points<br />"; |
|
} |
if ($tol eq '') { |
if ($tol eq '') { |
$tol=0.0; |
$tol=0.0; |
$tol_type=1; #TOL_ABSOLUTE |
$tol_type=1; #TOL_ABSOLUTE |
Line 63 sub caparesponse_check {
|
Line 76 sub caparesponse_check {
|
my $result = &caparesponse_capa_check_answer($response,$answer,$type, |
my $result = &caparesponse_capa_check_answer($response,$answer,$type, |
$tol_type,$tol, |
$tol_type,$tol, |
$sig_lbound,$sig_ubound, |
$sig_lbound,$sig_ubound, |
$ans_fmt,$unit,$calc); |
$ans_fmt,$unit,$calc,$id_list, |
|
$points,$external::randomseed); |
|
|
if ($result == '1') { $result='EXACT_ANS'; } |
if ($result == '1') { $result='EXACT_ANS'; } |
elsif ($result == '2') { $result='APPROX_ANS'; } |
elsif ($result == '2') { $result='APPROX_ANS'; } |
Line 79 sub caparesponse_check {
|
Line 93 sub caparesponse_check {
|
elsif ($result =='12') { $result='WANTED_NUMERIC'; } |
elsif ($result =='12') { $result='WANTED_NUMERIC'; } |
else {$result = "ERROR: Unknown Result:$result:$@:";} |
else {$result = "ERROR: Unknown Result:$result:$@:";} |
|
|
return "$result:<br />Error $error:<br />Answer $answer:<br />Response $response:<br /> type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$units<br />$message$expr"; |
return "$result:<br />Error $error:<br />Answer $answer:<br />Response $response:<br /> type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|<br />$message$expr"; |
} |
} |
|
|
sub caparesponse_check_list { |
sub get_array_args { |
my ($response,$expr)=@_; |
my ($expr,$arg)=@_; |
# do these first, because who knows what varname the instructor might have used |
# do these first, because who knows what varname the instructor might have used |
# but it probably isn't $CAPARESPONSE_CHECK_LIST_answer |
# but it probably isn't $CAPARESPONSE_CHECK_LIST_answer |
my $CAPARESPONSE_CHECK_LIST_answer = eval $expr.';return $answer'; |
my $CAPARESPONSE_CHECK_LIST_answer = eval $expr.';return $'.$arg; #' |
my (@list) = eval $CAPARESPONSE_CHECK_LIST_answer; |
if ($CAPARESPONSE_CHECK_LIST_answer =~ /^\s*[\$\@]/) { |
|
my (@list) = eval $CAPARESPONSE_CHECK_LIST_answer; |
|
} |
my $result=''; |
my $result=''; |
$result.="error:$@:<br />"; |
$result.="error:$@:<br />"; |
# if the eval fails just use what is in the answer exactly |
# if the eval fails just use what is in the answer exactly |
Line 95 sub caparesponse_check_list {
|
Line 111 sub caparesponse_check_list {
|
$result.="list zero is undefined<br />"; |
$result.="list zero is undefined<br />"; |
$list[0]=$CAPARESPONSE_CHECK_LIST_answer; |
$list[0]=$CAPARESPONSE_CHECK_LIST_answer; |
} |
} |
|
return @list; |
|
} |
|
|
|
sub caparesponse_check_list { |
|
my ($response,$expr)=@_; |
|
my (@list) = &get_array_args($expr,'answer'); |
my $aresult=''; |
my $aresult=''; |
my $current_answer; |
my $current_answer; |
$result.="Got response :$CAPARESPONSE_CHECK_LIST_answer:$list[0]:<br />"; |
my $answers=join(':',@list); |
|
$result.="Got response :$answers:<br />"; |
my @responselist; |
my @responselist; |
|
my $type =eval $expr.';return $answer;'; |
if ($type ne '' && $#list > 0) { |
if ($type ne '' && $#list > 0) { |
(@responselist)=split /,/,$response; |
(@responselist)=split /,/,$response; |
} else { |
} else { |
Line 179 sub hinton {
|
Line 203 sub hinton {
|
|
|
sub random { |
sub random { |
my ($start,$end,$step)=@_; |
my ($start,$end,$step)=@_; |
if ( ! $RANDOMINIT ) { srand($external::randomseed); $RANDOMINIT=1; } |
if ( ! $hidden::RANDOMINIT ) { |
|
srand($external::randomseed); |
|
$hidden::RANDOMINIT=1; |
|
} |
my $num=1+int(($end-$start)/$step); |
my $num=1+int(($end-$start)/$step); |
my $result=$start + int(rand() * $num)*$step; |
my $result=$start + int(rand() * $num)*$step; |
return $result; |
return $result; |
Line 258 sub random_noncentral_f {
|
Line 285 sub random_noncentral_f {
|
} |
} |
|
|
sub random_multivariate_normal { |
sub random_multivariate_normal { |
my ($item_cnt,$seed,@mean) = @_; |
my ($item_cnt,$seed,$mean,$covar) = @_; |
return "Number of deviates must be greater than 0" if $item_cnt <= 0; |
|
my (@covar,@retArray); |
|
my $ind = 0; |
|
while ($ind<$item_cnt) { |
|
push @covar, pop (@mean); |
|
$ind++; |
|
} |
|
&random_set_seed_from_phrase($seed); |
&random_set_seed_from_phrase($seed); |
@retArray=&math_random_multivariate_normal($item_cnt,@mean,@covar); |
@retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar); |
return @retArray; |
return @retArray; |
} |
} |
|
|