version 1.116, 2006/09/29 20:55:33
|
version 1.120, 2006/11/10 17:45:52
|
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 250 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:$@:";} |
|
|
&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) |
} |
} |
|
|
Line 290 sub implicit_multiplication {
|
Line 292 sub implicit_multiplication {
|
} |
} |
|
|
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); |
} |
} |
|
|