version 1.116, 2006/09/29 20:55:33
|
version 1.125, 2008/03/03 19:14:51
|
Line 58 use strict;
|
Line 58 use strict;
|
sub get_next_permutation { |
sub get_next_permutation { |
if ($num_left == $total) { |
if ($num_left == $total) { |
$num_left--; |
$num_left--; |
return @order; |
return \@order; |
} |
} |
|
|
# Find largest index j with a[j] < a[j+1] |
# Find largest index j with a[j] < a[j+1] |
Line 92 use strict;
|
Line 92 use strict;
|
} |
} |
|
|
$num_left--; |
$num_left--; |
return(@order); |
return(\@order); |
} |
} |
|
|
sub get_permutations_left { |
sub get_permutations_left { |
Line 126 sub check_commas {
|
Line 126 sub check_commas {
|
return 1; |
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 151 sub caparesponse_check {
|
Line 152 sub caparesponse_check {
|
} |
} |
if ($response=~ /^\s|\s$/) { |
if ($response=~ /^\s|\s$/) { |
$response=~ s:^\s+|\s+$::g; |
$response=~ s:^\s+|\s+$::g; |
&LONCAPA_INTENAL_DEBUG("Removed ws now :$response:"); |
&LONCAPA_INTERNAL_DEBUG("Removed ws now :$response:"); |
} |
} |
|
|
&LONCAPA_INTERNAL_DEBUG(" type is $type "); |
#&LONCAPA_INTERNAL_DEBUG(" type is $type "); |
if ($type eq 'cs' || $type eq 'ci') { |
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 |
Line 165 sub caparesponse_check {
|
Line 166 sub caparesponse_check {
|
$response=~s/[\s,]//g; |
$response=~s/[\s,]//g; |
} |
} |
if ($type eq 'float' && $unit=~/\$/) { |
if ($type eq 'float' && $unit=~/\$/) { |
if ($response!~/^\$/) { return "NO_UNIT: Missing \$ "; } |
if ($response!~/^\$/) { return ('NO_UNIT', undef); } |
$response=~s/\$//g; |
$response=~s/\$//g; |
} |
} |
if ($type eq 'float' && $unit=~/\,/ && (&check_commas($response)<0)) { |
if ($type eq 'float' && $unit=~/\,/ && (&check_commas($response)<0)) { |
Line 175 sub caparesponse_check {
|
Line 176 sub caparesponse_check {
|
$unit=~s/[\$,]//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 '' ) { |
&LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting"); |
&LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting"); |
Line 190 sub caparesponse_check {
|
Line 191 sub caparesponse_check {
|
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 216 sub caparesponse_check {
|
Line 217 sub caparesponse_check {
|
|
|
my $reterror=""; |
my $reterror=""; |
my $result; |
my $result; |
|
if ((($type eq '9') || ($type eq '8')) && ($response=~/\=/)) { return ('BAD_FORMULA','Please submit just an expression, not an equation.'); } |
if ($type eq '9') { |
if ($type eq '9') { |
$result = &maxima_check(&maxima_cas_formula_fix($response),&maxima_cas_formula_fix($answer),\$reterror); |
$result = &maxima_check(&maxima_cas_formula_fix($response),&maxima_cas_formula_fix($answer),\$reterror); |
} else { |
} else { |
Line 250 sub caparesponse_check {
|
Line 252 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:$@:";} |
|
|
&LONCAPA_INTERNAL_DEBUG("RetError $reterror: Answer $answer: Response $response: type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|",$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) |
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="Got response :".join(':',@LONCAPA::CAPAresponse_answer).":\n"; |
# &LONCAPA_INTERNAL_DEBUG(" answer is ". |
|
# &LONCAPA_INTERNAL_Dumper($LONCAPA::CAPAresponse_answer).":\n"); |
|
# &LONCAPA_INTERNAL_DEBUG(" respons is ". |
|
# &LONCAPA_INTERNAL_Dumper($responses).":\n"); |
&LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args)); |
&LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args)); |
my @responselist; |
|
my $type = $LONCAPA::CAPAresponse_args{'type'}; |
my $type = $LONCAPA::CAPAresponse_args{'type'}; |
&LONCAPA_INTERNAL_DEBUG("Got type :$type:\n"); |
&LONCAPA_INTERNAL_DEBUG("Got type :$type:\n"); |
my $num_answers = scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}}); |
|
if ($type ne '' |
my $num_input_lines = |
&& $num_answers > 1) { |
scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}}); |
(@responselist)=split(/,/,$response); |
|
if (@responselist < $num_answers) { |
if ($type ne '' ) { |
|
if (scalar(@$responses) < $num_input_lines) { |
return 'MISSING_ANSWER'; |
return 'MISSING_ANSWER'; |
} |
} |
if (@responselist > $num_answers) { |
if (scalar(@$responses) > $num_input_lines) { |
|
return 'EXTRA_ANSWER'; |
|
} |
|
|
|
} |
|
|
|
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'; |
return 'EXTRA_ANSWER'; |
} |
} |
} else { |
|
(@responselist)=($response); |
|
} |
} |
&LONCAPA_INTERNAL_DEBUG("Initial final response :$responselist['-1']:"); |
|
|
&LONCAPA_INTERNAL_DEBUG("Initial final response :$responses->[0][-1]:"); |
my $unit; |
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; |
} |
} |
} |
} |
&LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:"); |
&LONCAPA_INTERNAL_DEBUG("Final final response :$responses->[0][-1]:$unit:"); |
$unit=~s/\s//; |
$unit=~s/\s//; |
|
if ($unit ne '') { |
|
foreach my $response (@$responses) { |
|
foreach my $element (@$response) { |
|
$element .= " $unit"; |
|
} |
|
} |
|
} |
|
|
|
foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { |
|
if (!defined($thisanswer)) { |
|
return ('ERROR','answer was undefined'); |
|
} |
|
} |
|
|
|
|
|
# &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]; |
|
} |
|
} |
|
} |
|
|
#&reset_caparesponse_memoization(); |
|
my ($final_award,$final_msg); |
my ($final_award,$final_msg); |
&init_permutation(scalar(@responselist), |
&init_permutation(scalar(@$responses), |
$LONCAPA::CAPAresponse_answer->{'type'}); |
$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() ) { |
while( &get_permutations_left() ) { |
my @responses_ordered = @responselist[&get_next_permutation()]; |
my $order = &get_next_permutation(); |
my (@awards, @msgs, $i); |
my (@awards, @msgs, $i); |
foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { |
foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { |
my ($msg,$aresult); |
my $key = "$thisanswer\0".$responses->[$order->[$i]]; |
if (defined($thisanswer)) { |
push(@awards,$memoized{$key}[0]); |
my $response = $responses_ordered[$i]; |
push(@msgs,$memoized{$key}[1]); |
if ($unit eq '') { |
|
$response .= " $unit"; |
|
} |
|
($aresult,$msg)=&caparesponse_check($thisanswer,$response); |
|
} else { |
|
$aresult='ERROR'; |
|
$msg='answer was undefined'; |
|
} |
|
#&LONCAPA_INTERNAL_DEBUG("after if $aresult -- $msg"); |
|
my ($temp)=split(/:/, $aresult); |
|
push(@awards,$temp); |
|
push(@msgs,$msg); |
|
$i++; |
$i++; |
|
|
} |
} |
|
&LONCAPA_INTERNAL_DEBUG(" all awards ".join(':',@awards)); |
|
|
my ($possible_award,$possible_msg) = |
my ($possible_award,$possible_msg) = |
&LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); |
&LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); |
if ($final_award) { |
&LONCAPA_INTERNAL_DEBUG(" pos awards ".$possible_award); |
($final_award,$final_msg) = |
push(@final_awards,$possible_award); |
&LONCAPA_INTERNAL_FINALIZEAWARDS([$final_award,$possible_award], |
push(@final_msg,$possible_msg); |
[$final_msg,$possible_msg], |
|
undef,1); |
|
} else { |
|
($final_award,$final_msg) = ($possible_award,$possible_msg); |
|
} |
|
} |
} |
#&reset_caparesponse_memoization(); |
|
|
&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); |
return ($final_award,$final_msg); |
} |
} |
|
|
|
sub cas { |
|
my ($system,$input)=@_; |
|
my $output; |
|
if ($system eq 'maxima') { |
|
$output=&maxima_eval($input); |
|
} |
|
return $output; |
|
} |
|
|
sub tex { |
sub tex { |
if ( $external::target eq "tex" ) { |
if ( $external::target eq "tex" ) { |
return $_[0]; |
return $_[0]; |