version 1.77, 2004/03/26 20:10:42
|
version 1.101, 2005/07/13 20:44:29
|
Line 34 $rad2deg=180.0/$pi;
|
Line 34 $rad2deg=180.0/$pi;
|
$deg2rad=$pi/180.0; |
$deg2rad=$pi/180.0; |
$"=' '; |
$"=' '; |
|
|
|
sub check_commas { |
|
my ($response)=@_; |
|
#print("$response "); |
|
my @numbers=split(',',$response); |
|
#print(" numbers ".join('-',@numbers)." "); |
|
if (scalar(@numbers) > 1) { |
|
#print(" numbers[0] ".$numbers[0]." "); |
|
if (length($numbers[0]) > 3 || length($numbers[0]) == 0) { return -1; } |
|
shift(@numbers); |
|
#print(" numbers ".scalar(@numbers)." "); |
|
while (scalar(@numbers) > 1) { |
|
#print(" numbers ".join('-',@numbers)." "); |
|
if (length($numbers[0]) != 3) { return -2; } |
|
shift(@numbers); |
|
} |
|
my ($number)=split('\.',$numbers[0]); |
|
#print(" number ".$number." "); |
|
#print(" numbers[0] ".$numbers[0]." "); |
|
if (length($number) != 3) { return -3; } |
|
} else { |
|
my ($number)=split('\.',$numbers[0]); |
|
if (length($number) > 3) { return -4; } |
|
} |
|
return 1; |
|
} |
|
|
sub caparesponse_check { |
sub caparesponse_check { |
my ($answer,$response)=@_; |
my ($answer,$response)=@_; |
#not properly used yet: calc |
#not properly used yet: calc |
Line 41 sub caparesponse_check {
|
Line 67 sub caparesponse_check {
|
my $type=$LONCAPA::CAPAresponse_args{'type'}; |
my $type=$LONCAPA::CAPAresponse_args{'type'}; |
my $tol=$LONCAPA::CAPAresponse_args{'tol'}; |
my $tol=$LONCAPA::CAPAresponse_args{'tol'}; |
my $sig=$LONCAPA::CAPAresponse_args{'sig'}; |
my $sig=$LONCAPA::CAPAresponse_args{'sig'}; |
my $ans_fmt=$LONCAPA::CAPAresponse_args{'ans_fmt'}; |
my $ans_fmt=$LONCAPA::CAPAresponse_args{'format'}; |
my $unit=$LONCAPA::CAPAresponse_args{'unit'}; |
my $unit=$LONCAPA::CAPAresponse_args{'unit'}; |
my $calc=$LONCAPA::CAPAresponse_args{'calc'}; |
my $calc=$LONCAPA::CAPAresponse_args{'calc'}; |
my $samples=$LONCAPA::CAPAresponse_args{'samples'}; |
my $samples=$LONCAPA::CAPAresponse_args{'samples'}; |
Line 63 sub caparesponse_check {
|
Line 89 sub caparesponse_check {
|
} else { |
} else { |
$message .="no ws in :$response:\n"; |
$message .="no ws in :$response:\n"; |
} |
} |
if ($type eq 'cs' || $type eq 'ci' || $type eq 'mc') { |
&LONCAPA_INTERNAL_DEBUG(" type is $type "); |
|
if ($type eq 'cs' || $type eq 'ci') { |
#for string answers make surec all places spaces occur, there is |
#for string answers make surec all places spaces occur, there is |
#really only 1 space, in both the answer and the response |
#really only 1 space, in both the answer and the response |
$answer=~s/ +/ /g; |
$answer=~s/ +/ /g; |
$response=~s/ +/ /g; |
$response=~s/ +/ /g; |
} |
} elsif ($type eq 'mc') { |
|
$answer=~s/[\s,]//g; |
|
$response=~s/[\s,]//g; |
|
} |
|
if ($type eq 'float' && $unit=~/\$/) { |
|
if ($response!~/^\$/) { return "NO_UNIT: Missing \$ "; } |
|
$response=~s/\$//g; |
|
} |
|
if ($type eq 'float' && $unit=~/\,/ && (&check_commas($response)<0)) { |
|
return "COMMA_FAIL:"; |
|
} |
|
$ans_fmt=~s/\W//g; |
|
$unit=~s/[\$,]//g; |
|
if ($type eq 'float') { $response=~s/,//g; } |
|
|
if (length($response) > 500) { return "TOO_LONG: Answer too long"; } |
if (length($response) > 500) { return "TOO_LONG: Answer too long"; } |
|
|
if ($type eq '' ) { |
if ($type eq '' ) { |
Line 105 sub caparesponse_check {
|
Line 146 sub caparesponse_check {
|
} |
} |
} |
} |
|
|
if ($sig eq '') { |
($sig_ubound,$sig_lbound)=&LONCAPA_INTERNAL_get_sigrange($sig); |
$sig_lbound = 0; #SIG_LB_DEFAULT |
|
$sig_ubound =15; #SIG_UB_DEFAULT |
|
} else { |
|
($sig_lbound,$sig_ubound) = split /,/,$sig; |
|
if (!defined($sig_lbound)) { |
|
$sig_lbound = 0; #SIG_LB_DEFAULT |
|
$sig_ubound =15; #SIG_UB_DEFAULT |
|
} |
|
if (!defined($sig_ubound)) { $sig_ubound=$sig_lbound; } |
|
} |
|
my $reterror=""; |
my $reterror=""; |
my $result = &caparesponse_capa_check_answer($response,$answer,$type, |
my $result = &caparesponse_capa_check_answer($response,$answer,$type, |
$tol_type,$tol, |
$tol_type,$tol, |
Line 135 sub caparesponse_check {
|
Line 167 sub caparesponse_check {
|
elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; } |
elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; } |
elsif ($result =='10') { $result='SUB_RECORDED'; } |
elsif ($result =='10') { $result='SUB_RECORDED'; } |
elsif ($result =='11') { $result='BAD_FORMULA'; } |
elsif ($result =='11') { $result='BAD_FORMULA'; } |
|
elsif ($result =='12' && !$response) { $result='MISSING_ANSWER'; } |
|
elsif ($result =='12') { $result='WANTED_NUMERIC'; } |
elsif ($result =='13') { $result='UNIT_INVALID_INSTRUCTOR'; } |
elsif ($result =='13') { $result='UNIT_INVALID_INSTRUCTOR'; } |
elsif ($result =='141') { $result='UNIT_INVALID_STUDENT'; } |
elsif ($result =='141') { $result='UNIT_INVALID_STUDENT'; } |
elsif ($result =='142') { $result='UNIT_INVALID_STUDENT'; } |
elsif ($result =='142') { $result='UNIT_INVALID_STUDENT'; } |
Line 142 sub caparesponse_check {
|
Line 176 sub caparesponse_check {
|
elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; } |
elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; } |
else {$result = "ERROR: Unknown Result:$result:$@:";} |
else {$result = "ERROR: Unknown Result:$result:$@:";} |
|
|
return ("$result:\nRetError $reterror:\nError $error:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message",$reterror); |
return ("$result:\nRetError $reterror:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message",$reterror); |
} |
} |
|
|
|
|
Line 172 sub caparesponse_check_list {
|
Line 206 sub caparesponse_check_list {
|
$unit=$2; |
$unit=$2; |
} |
} |
} |
} |
$result.="Final final response :$responselist['-1']:\n"; |
$result.="Final final response :$responselist['-1']:$unit:\n"; |
$result.=":$#list: answers\n"; |
$result.=":$#list: answers\n"; |
$unit=~s/\s//; |
$unit=~s/\s//; |
my $i=0; |
my $i=0; |
Line 241 sub random {
|
Line 275 sub random {
|
if ( ! $hidden::RANDOMINIT ) { |
if ( ! $hidden::RANDOMINIT ) { |
if ($external::randomseed == 0) { $external::randomseed=1; } |
if ($external::randomseed == 0) { $external::randomseed=1; } |
if ($external::randomseed =~/,/) { |
if ($external::randomseed =~/,/) { |
my ($num1,$num2)=split(/,/,$seed); |
my ($num1,$num2)=split(/,/,$external::randomseed); |
|
&random_set_seed(1,abs($num1)); |
|
} elsif ($external::randomseed =~/:/) { |
|
my ($num1,$num2)=split(/:/,$external::randomseed); |
&random_set_seed(abs($num1),abs($num2)); |
&random_set_seed(abs($num1),abs($num2)); |
} else { |
} else { |
&random_set_seed(1,int(abs($external::randomseed))); |
&random_set_seed(1,int(abs($external::randomseed))); |
Line 349 sub random_multivariate_normal {
|
Line 386 sub random_multivariate_normal {
|
my ($item_cnt,$seed,$mean,$covar) = @_; |
my ($item_cnt,$seed,$mean,$covar) = @_; |
my @oldseed=&random_get_seed(); |
my @oldseed=&random_get_seed(); |
&random_set_seed_from_phrase($seed); |
&random_set_seed_from_phrase($seed); |
@retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar); |
my @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar); |
&random_set_seed(@oldseed); |
&random_set_seed(@oldseed); |
return @retArray; |
return @retArray; |
} |
} |
Line 359 sub random_multinomial {
|
Line 396 sub random_multinomial {
|
my @oldseed=&random_get_seed(); |
my @oldseed=&random_get_seed(); |
my @retArray; |
my @retArray; |
&random_set_seed_from_phrase($seed); |
&random_set_seed_from_phrase($seed); |
@retArray=&math_random_multinomial($item_cnt,@p); |
my @retArray=&math_random_multinomial($item_cnt,@p); |
&random_set_seed(@oldseed); |
&random_set_seed(@oldseed); |
return @retArray; |
return @retArray; |
} |
} |
Line 480 sub floor {return (($_[0]-CORE::int($_[
|
Line 517 sub floor {return (($_[0]-CORE::int($_[
|
|
|
sub format { |
sub format { |
my ($value,$fmt)=@_; |
my ($value,$fmt)=@_; |
my $dollarmode; |
my ($dollarmode,$commamode,$alwaysperiod,$options); |
if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } |
if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; } |
$fmt=~s/e/E/g; |
#if ($options =~ /\$/) { $dollamode=1; } |
my $result=sprintf('%.'.$fmt,$value); |
#if ($options =~ /,/) { $commamode=1; } |
$result=~s/(E[+-]*)0/$1/; |
if ($options =~ /\./) { $alwaysperiod=1; } |
if ($dollarmode) {$result=&dollarmode($result);} |
my $result; |
|
if ($fmt=~/s$/i) { |
|
$result=&format_significant_figures($value,$fmt); |
|
} else { |
|
$fmt=~s/e/E/g; |
|
$result=sprintf('%.'.$fmt,$value); |
|
if ($alwaysperiod && $fmt eq '0f') { $result .='.'; } |
|
$result=~s/(E[+-]*)0/$1/; |
|
} |
|
#if ($dollarmode) {$result=&dollarformat($result);} |
|
#if ($commamode) {$result=&commaformat($result);} |
return $result; |
return $result; |
} |
} |
|
|
sub chemparse { |
sub chemparse { |
my ($reaction) = @_; |
my ($reaction) = @_; |
my @tokens = split(/(\s\+|\->|<=>)/,$reaction); |
my @tokens = split(/(\s\+|\->|<=>|<\-|\.)/,$reaction); |
my $formula = ''; |
my $formula = ''; |
foreach my $token (@tokens) { |
foreach my $token (@tokens) { |
if ($token eq '->' ) { |
if ($token eq '->' ) { |
$formula .= '<m>\ensuremath{\rightarrow}</m> '; |
$formula .= '<m>\ensuremath{\rightarrow}</m> '; |
next; |
next; |
} |
} |
|
if ($token eq '<-' ) { |
|
$formula .= '<m>\ensuremath{\leftarrow}</m> '; |
|
next; |
|
} |
if ($token eq '<=>') { |
if ($token eq '<=>') { |
if ($external::target eq 'web' && |
if ($external::target eq 'web' && |
&EXT('request.browser.unicode')) { |
&EXT('request.browser.unicode')) { |
$formula .= '⇌ '; |
$formula .= '⇌ '; |
} else { |
} else { |
$formula .= &web('<=> ','<m>\ensuremath{\rightleftharpoons}</m> ', |
$formula .= &web('<=> ','<m>\ensuremath{\rightleftharpoons}</m> ', |
'<=$gt; '); |
'<=> '); |
} |
} |
next; |
next; |
} |
} |
$token =~ /^\s*(\d*)(.*)/; |
if ($token eq '.') { |
$formula .= $1 if ($1 > 1); # stoichiometric coefficient |
$formula =~ s/(\ \;| )$//; |
|
$formula .= '·'; |
|
next; |
|
} |
|
$token =~ /^\s*([\d|\/]*(?:&frac\d\d)?)(.*)/; |
|
$formula .= $1 if ($1 ne '1'); # stoichiometric coefficient |
|
|
my $molecule = $2; |
my $molecule = $2; |
# subscripts |
# subscripts |
$molecule =~ s|(?<=[a-zA-Z\[\s])(\d+)|<sub>$1</sub>|g; |
$molecule =~ s|(?<=[a-zA-Z\)\]\s])(\d+)|<sub>$1</sub>|g; |
# superscripts |
# superscripts |
$molecule =~ s|\^(\d*[+\-]*)|<sup>$1</sup>|g; |
$molecule =~ s|\^(\d*[+\-]*)|<sup>$1</sup>|g; |
# strip whitespace |
# strip whitespace |
$molecule =~ s/\s*//g; |
$molecule =~ s/\s*//g; |
# forced space |
# forced space |
$molecule =~ s/_/ /g; |
$molecule =~ s/_/ /g; |
|
$molecule =~ s/-/−/g; |
$formula .= $molecule.' '; |
$formula .= $molecule.' '; |
} |
} |
# get rid of trailing space |
# get rid of trailing space |
$formula =~ s/(\Q${nbsp}\E| )$//; |
$formula =~ s/(\ \;| )$//; |
|
|
return &xmlparse($formula); |
return &xmlparse($formula); |
} |
} |
|
|
sub prettyprint { |
sub prettyprint { |
my ($value,$fmt,$target)=@_; |
my ($value,$fmt,$target)=@_; |
my $result; |
my $result; |
my $dollarmode; |
|
if (!$target) { $target = $external::target; } |
if (!$target) { $target = $external::target; } |
if ($fmt =~ /chem/i) { return(&chemparse($value)); } |
if ($fmt =~ /chem/i) { return(&chemparse($value)); } |
if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } |
my ($dollarmode,$commamode,$alwaysperiod,$options); |
if ($fmt) { $value=sprintf('%.'.$fmt,$value); } |
if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; } |
|
if ($options =~ /\$/) { $dollarmode=1; } |
|
if ($options =~ /,/) { $commamode=1; } |
|
if ($options =~ /\./) { $alwaysperiod=1; } |
|
if ($fmt=~/s$/i) { |
|
$value=&format_significant_figures($value,$fmt); |
|
} elsif ($fmt) { |
|
$value=sprintf('%.'.$fmt,$value); |
|
} |
|
if ($alwaysperiod && $fmt eq '0f') { |
|
if ($target eq 'tex') { |
|
$value .='\\ensuremath{.}'; |
|
} else { |
|
$value .='.'; |
|
} |
|
} |
if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/i ) { |
if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/i ) { |
my $frac=$1; |
my $frac=$1; |
if ($dollarmode) { $frac=&dollarformat($frac); } |
if ($dollarmode) { $frac=&dollarformat($frac); } |
|
if ($commamode) { $frac=&commaformat($frac); } |
my $exponent=$2; |
my $exponent=$2; |
$exponent=~s/^\+0*//; |
$exponent=~s/^\+0*//; |
$exponent=~s/^-0*/-/; |
$exponent=~s/^-0*/-/; |
Line 557 sub prettyprint {
|
Line 628 sub prettyprint {
|
} |
} |
} else { |
} else { |
$result=$value; |
$result=$value; |
if ($dollarmode) { $result=&dollarformat($result,$target); } |
if ($dollarmode) { $result=&dollarformat($result,$target); } |
|
elsif ($commamode) { $result=&commaformat($result,$target); } |
} |
} |
return $result; |
return $result; |
} |
} |
|
|
sub dollarformat { |
sub commaformat { |
my ($number,$target) = @_; |
my ($number,$target) = @_; |
if (!$target) { $target = $external::target; } |
|
if ($number =~ /\./) { |
if ($number =~ /\./) { |
while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) { |
while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) { |
$number = $1.','.$2.$3; |
$number = $1.','.$2.$3; |
Line 574 sub dollarformat {
|
Line 645 sub dollarformat {
|
$number = $1.','.$2.$3; |
$number = $1.','.$2.$3; |
} |
} |
} |
} |
|
return $number; |
|
} |
|
|
|
sub dollarformat { |
|
my ($number,$target) = @_; |
|
if (!$target) { $target = $external::target; } |
|
$number=&commaformat($number,$target); |
if ($target eq 'tex') { |
if ($target eq 'tex') { |
$number='\$'.$number; #' stupid emacs |
$number='\$'.$number; #' stupid emacs |
} else { |
} else { |
Line 582 sub dollarformat {
|
Line 660 sub dollarformat {
|
return $number; |
return $number; |
} |
} |
|
|
|
# format of form ns or nS where n is an integer |
|
sub format_significant_figures { |
|
my ($number,$format) = @_; |
|
return '0' if ($number == 0); |
|
# extract number of significant figures needed |
|
my ($sig) = ($format =~ /(\d+)s/i); |
|
# arbitrary choice - suggestions ?? or throw error message? |
|
$sig = 3 if ($sig eq ''); |
|
# save the minus sign |
|
my $sign = ($number < 0) ? '-' : ''; |
|
$number = abs($number); |
|
# needed to correct for a number greater than 1 (or |
|
my $power = ($number < 1) ? 0 : 1; |
|
# could round up. Take the integer part of log10. |
|
my $x10 = int(log($number)/log(10)); |
|
# find number with values left of decimal pt = # of sign figs. |
|
my $xsig = $number*10**($sig-$x10-$power); |
|
# get just digits left of decimal pt - also rounds off correctly |
|
my $xint = sprintf('%.0f',$xsig); |
|
# save any trailing zero's |
|
my ($zeros) = ($xint =~ /(0+)$/); |
|
# return number to original magnitude |
|
my $numSig = $xint*10**($x10-$sig+$power); |
|
# insert trailing zero's if have decimal point |
|
$numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/; |
|
# put a decimal pt for number ending with 0 and length = # of sig fig |
|
$numSig.='.' if (length($numSig) == $sig && $numSig =~ /0$/); |
|
if (length($numSig) < $sig) { |
|
$numSig.='.'.substr($zeros,0,($sig-length($numSig))); |
|
} |
|
# return number with sign |
|
return $sign.$numSig; |
|
|
|
} |
|
|
sub map { |
sub map { |
my ($phrase,$dest,$source)=@_; |
my ($phrase,$dest,$source)=@_; |
my @oldseed=&random_get_seed(); |
my @oldseed=&random_get_seed(); |
Line 777 sub choose {
|
Line 890 sub choose {
|
return $_[$num]; |
return $_[$num]; |
} |
} |
|
|
|
#&sum1(1,$x,sub { &sum1($_[0],2*$_[0], sub { fact($_[0])**2 })}); |
|
#sub sum1 { |
|
# my ($start,$end,$sub)=@_; |
|
# my $sum=0; |
|
# for (my $i=$start;$i<=$end;$i++) { |
|
# $sum+=&$sub($i); |
|
# } |
|
# return $sum |
|
#} |
|
|
|
#&sum2('a',1,$x,'&sum2(\'b\',$a,2*$a, \'&factorial($b)**2\')'); |
|
#sub sum2 { |
|
# my ($varname,$start,$end,$line)=@_; |
|
# my $sum=0; |
|
# for (my $i=$start;$i<=$end;$i++) { |
|
# my $func=sub { |
|
# eval("\$".$varname."=$i"); |
|
# eval($line); |
|
# }; |
|
# $sum+=&$func($i); |
|
# } |
|
# return $sum |
|
#} |
|
|
# expiremental idea |
# expiremental idea |
sub proper_path { |
sub proper_path { |
my ($path)=@_; |
my ($path)=@_; |