version 1.84, 2004/05/27 04:25:13
|
version 1.120, 2006/11/10 17:45:52
|
Line 33 $pi=atan2(1,1)*4;
|
Line 33 $pi=atan2(1,1)*4;
|
$rad2deg=180.0/$pi; |
$rad2deg=180.0/$pi; |
$deg2rad=$pi/180.0; |
$deg2rad=$pi/180.0; |
$"=' '; |
$"=' '; |
|
use strict; |
|
{ |
|
my $n = 0; |
|
my $total = 0; |
|
my $num_left = 0; |
|
my @order; |
|
my $type; |
|
|
|
sub init_permutation { |
|
my ($size,$requested_type) = @_; |
|
@order = (0..$size-1); |
|
$n = $size; |
|
$type = $requested_type; |
|
if ($type eq 'ordered') { |
|
$total = $num_left = 1; |
|
} elsif ($type eq 'unordered') { |
|
$total = $num_left = &factorial($size); |
|
} else { |
|
die("Unkown type: $type"); |
|
} |
|
} |
|
|
|
sub get_next_permutation { |
|
if ($num_left == $total) { |
|
$num_left--; |
|
return \@order; |
|
} |
|
|
|
# Find largest index j with a[j] < a[j+1] |
|
|
|
my $j = scalar(@order) - 2; |
|
while ($order[$j] > $order[$j+1]) { |
|
$j--; |
|
} |
|
|
|
# Find index k such that a[k] is smallest integer |
|
# greater than a[j] to the right of a[j] |
|
|
|
my $k = scalar(@order) - 1; |
|
while ($order[$j] > $order[$k]) { |
|
$k--; |
|
} |
|
|
|
# Interchange a[j] and a[k] |
|
|
|
@order[($k,$j)] = @order[($j,$k)]; |
|
|
|
# Put tail end of permutation after jth position in increasing order |
|
|
|
my $r = scalar(@order) - 1; |
|
my $s = $j + 1; |
|
|
|
while ($r > $s) { |
|
@order[($s,$r)]=@order[($r,$s)]; |
|
$r--; |
|
$s++; |
|
} |
|
|
|
$num_left--; |
|
return(\@order); |
|
} |
|
|
|
sub get_permutations_left { |
|
return $num_left; |
|
} |
|
} |
|
|
|
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)=@_; |
Line 41 sub caparesponse_check {
|
Line 134 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 52 sub caparesponse_check {
|
Line 145 sub caparesponse_check {
|
|
|
|
|
#type's definitons come from capaParser.h |
#type's definitons come from capaParser.h |
my $message=''; |
|
#remove leading and trailing whitespace |
#remove leading and trailing whitespace |
if (!defined($response)) { |
if (!defined($response)) { |
$response=''; |
$response=''; |
} |
} |
if ($response=~ /^\s|\s$/) { |
if ($response=~ /^\s|\s$/) { |
$response=~ s:^\s+|\s+$::g; |
$response=~ s:^\s+|\s+$::g; |
$message .="Removed ws now :$response:\n"; |
&LONCAPA_INTERNAL_DEBUG("Removed ws now :$response:"); |
} else { |
|
$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', undef); } |
|
$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 ($type eq 'float') { $response=~s/,//g; } |
if (length($response) > 500) { return "TOO_LONG: Answer too long"; } |
|
|
if (length($response) > 500) { return ('TOO_LONG',undef); } |
|
|
if ($type eq '' ) { |
if ($type eq '' ) { |
$message .= "Didn't find a type :$type: defaulting\n"; |
&LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting"); |
if ( $answer eq ($answer *1.0)) { $type = 2; |
if ( $answer eq ($answer *1.0)) { $type = 2; |
} else { $type = 3; } |
} else { $type = 3; } |
} else { |
} else { |
if ($type eq 'cs') { $type = 4; } |
if ($type eq 'cs') { $type = 4; } |
elsif ($type eq 'ci') { $type = 3 } |
elsif ($type eq 'ci') { $type = 3 } |
elsif ($type eq 'mc') { $type = 5; } |
elsif ($type eq 'mc') { $type = 5; } |
elsif ($type eq 'fml') { $type = 8; } |
elsif ($type eq 'fml') { $type = 8; } |
|
elsif ($type eq 'math') { $type = 9; } |
elsif ($type eq 'subj') { $type = 7; } |
elsif ($type eq 'subj') { $type = 7; } |
elsif ($type eq 'float') { $type = 2; } |
elsif ($type eq 'float') { $type = 2; } |
elsif ($type eq 'int') { $type = 1; } |
elsif ($type eq 'int') { $type = 1; } |
else { return "ERROR: Unknown type of answer: $type" } |
else { return ('ERROR', "Unknown type of answer: $type") } |
} |
} |
|
|
my $points; |
my $points; |
Line 92 sub caparesponse_check {
|
Line 199 sub caparesponse_check {
|
#formula type setup the sample points |
#formula type setup the sample points |
if ($type eq '8') { |
if ($type eq '8') { |
($id_list,$points)=split(/@/,$samples); |
($id_list,$points)=split(/@/,$samples); |
$message.="Found :$id_list:$points: points in $samples\n"; |
&LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples"); |
} |
} |
if ($tol eq '') { |
if ($tol eq '') { |
$tol=0.0; |
$tol=0.0; |
Line 106 sub caparesponse_check {
|
Line 213 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; |
|
if ($type eq '9') { |
|
$result = &maxima_check(&maxima_cas_formula_fix($response),&maxima_cas_formula_fix($answer),\$reterror); |
|
} else { |
|
if ($type eq '8') { # fml type |
|
$response = &capa_formula_fix($response); |
|
$answer = &capa_formula_fix($answer); |
|
} |
|
$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,$id_list, |
$ans_fmt,$unit,$calc,$id_list, |
$points,$external::randomseed, |
$points,$external::randomseed, |
\$reterror); |
\$reterror); |
|
} |
if ($result == '1') { $result='EXACT_ANS'; } |
if ($result == '1') { $result='EXACT_ANS'; } |
elsif ($result == '2') { $result='APPROX_ANS'; } |
elsif ($result == '2') { $result='APPROX_ANS'; } |
elsif ($result == '3') { $result='SIG_FAIL'; } |
elsif ($result == '3') { $result='SIG_FAIL'; } |
Line 136 sub caparesponse_check {
|
Line 242 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 143 sub caparesponse_check {
|
Line 251 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:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message",$reterror); |
&LONCAPA_INTERNAL_DEBUG("RetError $reterror: Answer $answer: Response $response: type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|"); |
|
&LONCAPA_INTERNAL_DEBUG(" $answer $response $result "); |
|
return ($result,$reterror) |
|
} |
|
|
|
sub maxima_cas_formula_fix { |
|
my ($expression)=@_; |
|
return &implicit_multiplication($expression); |
|
} |
|
|
|
sub capa_formula_fix { |
|
my ($expression)=@_; |
|
return &implicit_multiplication($expression); |
|
} |
|
|
|
sub implicit_multiplication { |
|
my ($expression)=@_; |
|
# Escape scientific notation, so 3e8 does not become 3*e*8 |
|
# 3e8 -> 3&8; 3e-8 -> 3&-8; 3E+8 -> e&+8 |
|
$expression=~s/(\d+)e([\+\-]*\d+)/$1\&\($2\)/gsi; |
|
# 3x10^8 -> 3&8; 3*10^-8 -> 3&-8 |
|
$expression=~s/(\d+)(?:x|\*)10(?:\^|\*\*)([\+\-]*\d+)/$1\&\($2\)/gsi; |
|
# Fill in multiplication signs |
|
# a b -> a*b;3 b -> 3*b;3 4 -> 3*4 |
|
$expression=~s/(\w)\s+(\w)/$1\*$2/gs; |
|
# )( -> )*(; ) ( -> )*( |
|
$expression=~s/\)\s*\(/\)\*\(/gs; |
|
# 3a -> 3*a; 3( -> 3*(; 3 ( -> 3*(; 3A -> 3*A |
|
$expression=~s/(\d)\s*([a-zA-Z\(])/$1\*$2/gs; |
|
# a ( -> a*( |
|
$expression=~s/(\w)\s+\(/$1\*\(/gs; |
|
# a3 -> a*3; |
|
$expression=~s/([a-zA-Z])(\d)/$1\*$2/gs; |
|
# )a -> )*a; )3 -> )*3; ) 3 -> )*3 |
|
$expression=~s/\)\s*(\w)/\)\*$1/gs; |
|
# 3&8 -> 3e8; 3&-4 -> 3e-4 |
|
$expression=~s/(\d+)\&\(([\+\-]*\d+)\)/$1e$2/gs; |
|
return $expression; |
} |
} |
|
|
|
|
sub caparesponse_check_list { |
sub caparesponse_check_list { |
my $response=$LONCAPA::CAPAresponse_args{'response'}; |
my $responses=$LONCAPA::CAPAresponse_args{'response'}; |
my ($result,@list); |
&LONCAPA_INTERNAL_DEBUG(" answer is ". |
@list=@LONCAPA::CAPAresponse_answer; |
&LONCAPA_INTERNAL_Dumper($LONCAPA::CAPAresponse_answer).":\n"); |
my $aresult=''; |
&LONCAPA_INTERNAL_DEBUG(" respons is ". |
my $current_answer; |
&LONCAPA_INTERNAL_Dumper($responses).":\n"); |
my $answers=join(':',@list); |
&LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args)); |
$result.="Got response :$answers:\n"; |
|
&LONCAPA_INTERNAL_DEBUG("<blink>Yo!</blink> got ".join(':',%LONCAPA::CAPAresponse_args)); |
|
my @responselist; |
|
my $type = $LONCAPA::CAPAresponse_args{'type'}; |
my $type = $LONCAPA::CAPAresponse_args{'type'}; |
$result.="Got type :$type:\n"; |
&LONCAPA_INTERNAL_DEBUG("Got type :$type:\n"); |
if ($type ne '' && $#list > 0) { |
|
(@responselist)=split /,/,$response; |
my $num_input_lines = |
} else { |
scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}}); |
(@responselist)=($response); |
|
|
if ($type ne '' ) { |
|
if (scalar(@$responses) < $num_input_lines) { |
|
return 'MISSING_ANSWER'; |
|
} |
|
if (scalar(@$responses) > $num_input_lines) { |
|
return 'EXTRA_ANSWER'; |
|
} |
|
|
} |
} |
my $unit=''; |
|
$result.="Initial final response :$responselist['-1']:\n"; |
foreach my $which (0..($num_input_lines-1)) { |
|
my $answer_size = |
|
scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}[$which]}); |
|
if ($type ne '' |
|
&& $answer_size > 1) { |
|
$responses->[$which]=[split(/,/,$responses->[$which])]; |
|
} else { |
|
$responses->[$which]=[$responses->[$which]]; |
|
} |
|
} |
|
&LONCAPA_INTERNAL_DEBUG(" parsed response is ". |
|
&LONCAPA_INTERNAL_Dumper($responses).":\n"); |
|
foreach my $which (0..($num_input_lines-1)) { |
|
my $answer_size = |
|
scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}[$which]}); |
|
my $response_size = |
|
scalar(@{$responses->[$which]}); |
|
if ($answer_size > $response_size) { |
|
return 'MISSING_ANSWER'; |
|
} |
|
if ($answer_size < $response_size) { |
|
return 'EXTRA_ANSWER'; |
|
} |
|
} |
|
|
|
&LONCAPA_INTERNAL_DEBUG("Initial final response :$responses->[0][-1]:"); |
|
my $unit; |
if ($type eq '' || $type eq 'float') { |
if ($type eq '' || $type eq 'float') { |
#for numerical problems split off the unit |
#for numerical problems split off the unit |
if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) { |
if ( $responses->[0][-1]=~ /(.*[^\s])\s+([^\s]+)/ ) { |
$responselist['-1']=$1; |
$responses->[0][-1]=$1; |
$unit=$2; |
$unit=$2; |
} |
} |
} |
} |
$result.="Final final response :$responselist['-1']:$unit:\n"; |
&LONCAPA_INTERNAL_DEBUG("Final final response :$responses->[0][-1]:$unit:"); |
$result.=":$#list: answers\n"; |
|
$unit=~s/\s//; |
$unit=~s/\s//; |
my $i=0; |
if ($unit ne '') { |
my $awards=''; |
foreach my $response (@$responses) { |
my @msgs; |
foreach my $element (@$response) { |
for ($i=0; $i<@list;$i++) { |
$element .= " $unit"; |
my $msg; |
} |
$result.="trying answer :$list[$i]:\n"; |
} |
my $thisanswer=$list[$i]; |
} |
$result.="trying answer :$thisanswer:\n"; |
|
if ($unit eq '') { |
foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { |
($aresult,$msg)=&caparesponse_check($thisanswer,$responselist[$i]); |
if (!defined($thisanswer)) { |
} else { |
return ('ERROR','answer was undefined'); |
($aresult,$msg)=&caparesponse_check($thisanswer, |
} |
$responselist[$i]." $unit"); |
} |
|
|
|
|
|
&LONCAPA_INTERNAL_DEBUG(&LONCAPA_INTERNAL_Dumper($responses)); |
|
my %memoized; |
|
if ($LONCAPA::CAPAresponse_answer->{'type'} eq 'ordered') { |
|
for (my $i=0; $i<scalar(@$responses);$i++) { |
|
my $answer = $LONCAPA::CAPAresponse_answer->{'answers'}[$i]; |
|
my $response = $responses->[$i]; |
|
my $key = "$answer\0$response"; |
|
my (@awards,@msgs); |
|
for (my $j=0; $j<scalar(@$response); $j++) { |
|
my ($award,$msg) = &caparesponse_check($answer->[$j], |
|
$response->[$j]); |
|
push(@awards,$award); |
|
push(@msgs, $msg); |
|
} |
|
my ($award,$msg) = |
|
&LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); |
|
$memoized{$key} = [$award,$msg]; |
|
} |
|
} else { |
|
#FIXME broken with unorder responses where one is a <value> |
|
# and the other is a <vector> (need to delay parse til |
|
# inside the loop?) |
|
foreach my $response (@$responses) { |
|
my $response_size = scalar(@{$response}); |
|
foreach my $answer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { |
|
my $key = "$answer\0$response"; |
|
my $answer_size = scalar(@{$answer}); |
|
my ($award,$msg); |
|
if ($answer_size > $response_size) { |
|
$award = 'MISSING_ANSWER'; |
|
} elsif ($answer_size < $response_size) { |
|
$award = 'EXTRA_ANSWER'; |
|
} else { |
|
my (@awards,@msgs); |
|
for (my $j=0; $j<scalar(@$response); $j++) { |
|
my ($award,$msg) = &caparesponse_check($answer->[$j], |
|
$response->[$j]); |
|
push(@awards,$award); |
|
push(@msgs, $msg); |
|
} |
|
($award,$msg) = |
|
&LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); |
|
} |
|
$memoized{$key} = [$award,$msg]; |
|
} |
} |
} |
my ($temp)=split /:/, $aresult; |
|
$awards.="$temp,"; |
|
$result.=$aresult; |
|
push(@msgs,$msg); |
|
} |
} |
chop $awards; |
|
return ("$awards:\n$result",@msgs); |
my ($final_award,$final_msg); |
|
&init_permutation(scalar(@$responses), |
|
$LONCAPA::CAPAresponse_answer->{'type'}); |
|
|
|
# possible FIXMEs |
|
# - significant time is spent calling non-safe space routine |
|
# from safe space |
|
# - early outs could be possible with classifying awards is to stratas |
|
# and stopping as so as hitting the top strata |
|
# - some early outs also might be possible with check ing the |
|
# memoized hash of results (is correct even possible? etc.) |
|
|
|
my (@final_awards,@final_msg); |
|
while( &get_permutations_left() ) { |
|
my $order = &get_next_permutation(); |
|
my (@awards, @msgs, $i); |
|
foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { |
|
my $key = "$thisanswer\0".$responses->[$order->[$i]]; |
|
push(@awards,$memoized{$key}[0]); |
|
push(@msgs,$memoized{$key}[1]); |
|
$i++; |
|
|
|
} |
|
&LONCAPA_INTERNAL_DEBUG(" all awards ".join(':',@awards)); |
|
|
|
my ($possible_award,$possible_msg) = |
|
&LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); |
|
&LONCAPA_INTERNAL_DEBUG(" pos awards ".$possible_award); |
|
push(@final_awards,$possible_award); |
|
push(@final_msg,$possible_msg); |
|
} |
|
|
|
&LONCAPA_INTERNAL_DEBUG(" all final_awards ".join(':',@final_awards)); |
|
my ($final_award,$final_msg) = |
|
&LONCAPA_INTERNAL_FINALIZEAWARDS(\@final_awards,\@final_msg,undef,1); |
|
return ($final_award,$final_msg); |
} |
} |
|
|
sub tex { |
sub tex { |
Line 353 sub random_multivariate_normal {
|
Line 605 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 363 sub random_multinomial {
|
Line 615 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 418 sub random_negative_binomial {
|
Line 670 sub random_negative_binomial {
|
return @retArray; |
return @retArray; |
} |
} |
|
|
sub abs { abs(shift) } |
sub abs { CORE::abs(shift) } |
sub sin { sin(shift) } |
sub sin { CORE::sin(shift) } |
sub cos { cos(shift) } |
sub cos { CORE::cos(shift) } |
sub exp { exp(shift) } |
sub exp { CORE::exp(shift) } |
sub int { int(shift) } |
sub int { CORE::int(shift) } |
sub log { log(shift) } |
sub log { CORE::log(shift) } |
sub atan2 { atan2($_[0],$_[1]) } |
sub atan2 { CORE::atan2($_[0],$_[1]) } |
sub sqrt { sqrt(shift) } |
sub sqrt { CORE::sqrt(shift) } |
|
|
sub tan { CORE::sin($_[0]) / CORE::cos($_[0]) } |
sub tan { CORE::sin($_[0]) / CORE::cos($_[0]) } |
#sub atan { atan2($_[0], 1); } |
#sub atan { atan2($_[0], 1); } |
Line 489 sub format {
|
Line 741 sub format {
|
#if ($options =~ /\$/) { $dollamode=1; } |
#if ($options =~ /\$/) { $dollamode=1; } |
#if ($options =~ /,/) { $commamode=1; } |
#if ($options =~ /,/) { $commamode=1; } |
if ($options =~ /\./) { $alwaysperiod=1; } |
if ($options =~ /\./) { $alwaysperiod=1; } |
$fmt=~s/e/E/g; |
my $result; |
my $result=sprintf('%.'.$fmt,$value); |
if ($fmt=~/s$/i) { |
if ($alwaysperiod && $fmt eq '0f') { $result .='.'; } |
$result=&format_significant_figures($value,$fmt); |
$result=~s/(E[+-]*)0/$1/; |
} 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 ($dollarmode) {$result=&dollarformat($result);} |
#if ($commamode) {$result=&commaformat($result);} |
#if ($commamode) {$result=&commaformat($result);} |
return $result; |
return $result; |
Line 500 sub format {
|
Line 757 sub format {
|
|
|
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 |
Line 529 sub chemparse {
|
Line 795 sub chemparse {
|
$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); |
} |
} |
|
|
Line 544 sub prettyprint {
|
Line 810 sub prettyprint {
|
if ($fmt =~ /chem/i) { return(&chemparse($value)); } |
if ($fmt =~ /chem/i) { return(&chemparse($value)); } |
my ($dollarmode,$commamode,$alwaysperiod,$options); |
my ($dollarmode,$commamode,$alwaysperiod,$options); |
if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; } |
if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; } |
if ($options =~ /\$/) { $dollamode=1; } |
if ($options =~ /\$/) { $dollarmode=1; } |
if ($options =~ /,/) { $commamode=1; } |
if ($options =~ /,/) { $commamode=1; } |
if ($options =~ /\./) { $alwaysperiod=1; } |
if ($options =~ /\./) { $alwaysperiod=1; } |
if ($fmt) { $value=sprintf('%.'.$fmt,$value); } |
if ($fmt=~/s$/i) { |
|
$value=&format_significant_figures($value,$fmt); |
|
} elsif ($fmt) { |
|
$value=sprintf('%.'.$fmt,$value); |
|
} |
if ($alwaysperiod && $fmt eq '0f') { |
if ($alwaysperiod && $fmt eq '0f') { |
if ($target eq 'tex') { |
if ($target eq 'tex') { |
$value .='\\ensuremath{.}'; |
$value .='\\ensuremath{.}'; |
Line 577 sub prettyprint {
|
Line 847 sub prettyprint {
|
} |
} |
} else { |
} else { |
$result=$value; |
$result=$value; |
if ($dollarmode) { $result=&dollarformat($result,$target); } |
if ($dollarmode) { $result=&dollarformat($result,$target); } |
if ($commamode) { $result=&commaformat($result,$target); } |
elsif ($commamode) { $result=&commaformat($result,$target); } |
} |
} |
return $result; |
return $result; |
} |
} |
Line 586 sub prettyprint {
|
Line 856 sub prettyprint {
|
sub commaformat { |
sub commaformat { |
my ($number,$target) = @_; |
my ($number,$target) = @_; |
if ($number =~ /\./) { |
if ($number =~ /\./) { |
while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) { |
while ($number =~ /([^0-9]*)([0-9]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) { |
$number = $1.','.$2.$3; |
$number = $1.$2.','.$3.$4; |
} |
} |
} else { |
} else { |
while ($number =~ /([^,]+)([^,][^,][^,])([,0-9]*)$/) { |
while ($number =~ /^([^0-9]*)([0-9]+)([^,][^,][^,])([,0-9]*)$/) { |
$number = $1.','.$2.$3; |
$number = $1.$2.','.$3.$4; |
} |
} |
} |
} |
return $number; |
return $number; |
Line 609 sub dollarformat {
|
Line 879 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 720 sub class {
|
Line 1025 sub class {
|
return $course; |
return $course; |
} |
} |
|
|
|
sub firstname { |
|
my $firstname = &EXT('environment.firstname'); |
|
$firstname = '' if $firstname eq ""; |
|
return $firstname; |
|
} |
|
|
|
sub lastname { |
|
my $lastname = &EXT('environment.lastname'); |
|
$lastname = '' if $lastname eq ""; |
|
return $lastname; |
|
} |
|
|
sub sec { |
sub sec { |
my $sec = &EXT('request.course.sec'); |
my $sec = &EXT('request.course.sec'); |
$sec = '' if $sec eq ""; |
$sec = '' if $sec eq ""; |
Line 804 sub choose {
|
Line 1121 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)=@_; |