version 1.116, 2006/09/29 20:55:33
|
version 1.117, 2006/09/29 23:10:22
|
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"); |
if ( $answer eq ($answer *1.0)) { $type = 2; |
if ( $answer eq ($answer *1.0)) { $type = 2; |
} else { $type = 3; } |
} else { $type = 3; } |
} else { |
} else { |
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 198 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); |
&LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples"); |
#&LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples"); |
} |
} |
if ($tol eq '') { |
if ($tol eq '') { |
$tol=0.0; |
$tol=0.0; |
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 321 sub caparesponse_check_list {
|
Line 323 sub caparesponse_check_list {
|
&LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:"); |
&LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:"); |
$unit=~s/\s//; |
$unit=~s/\s//; |
|
|
#&reset_caparesponse_memoization(); |
foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { |
|
if (!defined($thisanswer)) { |
|
return ('ERROR','answer was undefined'); |
|
} |
|
} |
|
|
|
if ($unit ne '') { |
|
foreach my $response (@responselist) { |
|
$response .= " $unit"; |
|
} |
|
} |
|
|
|
my %memoized; |
|
if ($LONCAPA::CAPAresponse_answer->{'type'} eq 'ordered') { |
|
for (my $i=0; $i<scalar(@responselist);$i++) { |
|
my $answer = $LONCAPA::CAPAresponse_answer->{'answers'}[$i]; |
|
my $response = $responselist[$i]; |
|
my $key = "$answer\0$response"; |
|
$memoized{$key} = [&caparesponse_check($answer, $response)]; |
|
} |
|
} else { |
|
foreach my $response (@responselist) { |
|
foreach my $answer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { |
|
my $key = "$answer\0$response"; |
|
$memoized{$key} = [&caparesponse_check($answer, $response)]; |
|
} |
|
} |
|
} |
|
|
my ($final_award,$final_msg); |
my ($final_award,$final_msg); |
&init_permutation(scalar(@responselist), |
&init_permutation(scalar(@responselist), |
$LONCAPA::CAPAresponse_answer->{'type'}); |
$LONCAPA::CAPAresponse_answer->{'type'}); |
|
|
|
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".$responselist[$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++; |
} |
} |
my ($possible_award,$possible_msg) = |
my ($possible_award,$possible_msg) = |
&LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); |
&LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); |
if ($final_award) { |
push(@final_awards,$possible_award); |
($final_award,$final_msg) = |
push(@final_msg,$possible_msg); |
&LONCAPA_INTERNAL_FINALIZEAWARDS([$final_award,$possible_award], |
|
[$final_msg,$possible_msg], |
|
undef,1); |
|
} else { |
|
($final_award,$final_msg) = ($possible_award,$possible_msg); |
|
} |
|
} |
} |
#&reset_caparesponse_memoization(); |
|
|
my ($final_award,$final_msg) = |
|
&LONCAPA_INTERNAL_FINALIZEAWARDS(\@final_awards,\@final_msg,undef,1); |
return ($final_award,$final_msg); |
return ($final_award,$final_msg); |
} |
} |
|
|