--- loncom/homework/default_homework.lcpm 2006/10/02 18:23:38 1.118 +++ loncom/homework/default_homework.lcpm 2006/11/01 23:24:52 1.119 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run() # -# $Id: default_homework.lcpm,v 1.118 2006/10/02 18:23:38 albertel Exp $ +# $Id: default_homework.lcpm,v 1.119 2006/11/01 23:24:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -152,7 +152,7 @@ sub caparesponse_check { } if ($response=~ /^\s|\s$/) { $response=~ s:^\s+|\s+$::g; - #&LONCAPA_INTERNAL_DEBUG("Removed ws now :$response:"); + &LONCAPA_INTERNAL_DEBUG("Removed ws now :$response:"); } #&LONCAPA_INTERNAL_DEBUG(" type is $type "); @@ -179,7 +179,7 @@ sub caparesponse_check { if (length($response) > 500) { return ('TOO_LONG',undef); } 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; } else { $type = 3; } } else { @@ -199,7 +199,7 @@ sub caparesponse_check { #formula type setup the sample points if ($type eq '8') { ($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 '') { $tol=0.0; @@ -251,8 +251,8 @@ sub caparesponse_check { elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; } 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|"); - #&LONCAPA_INTERNAL_DEBUG(" $answer $response $result "); + &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) } @@ -292,68 +292,129 @@ sub implicit_multiplication { } sub caparesponse_check_list { - my $response=$LONCAPA::CAPAresponse_args{'response'}; - my $result="Got response :".join(':',@LONCAPA::CAPAresponse_answer).":\n"; + my $responses=$LONCAPA::CAPAresponse_args{'response'}; + &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)); - my @responselist; my $type = $LONCAPA::CAPAresponse_args{'type'}; &LONCAPA_INTERNAL_DEBUG("Got type :$type:\n"); - my $num_answers = scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}}); + + my $num_input_lines = + scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}}); if ($type ne '' - && $num_answers > 1) { - (@responselist)=split(/,/,$response); - if (@responselist < $num_answers) { + && $num_input_lines > 1) { + if (scalar(@$responses) < $num_input_lines) { return 'MISSING_ANSWER'; } - if (@responselist > $num_answers) { + if (scalar(@$responses) > $num_input_lines) { return 'EXTRA_ANSWER'; } - } else { - (@responselist)=($response); + + } + + 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("Initial final response :$responselist['-1']:"); + &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') { #for numerical problems split off the unit - if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) { - $responselist['-1']=$1; + if ( $responses->[0][-1]=~ /(.*[^\s])\s+([^\s]+)/ ) { + $responses->[0][-1]=$1; $unit=$2; } } - &LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:"); + &LONCAPA_INTERNAL_DEBUG("Final final response :$responses->[0][-1]:$unit:"); $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'); } } - if ($unit ne '') { - foreach my $response (@responselist) { - $response .= " $unit"; - } - } + &LONCAPA_INTERNAL_DEBUG(&LONCAPA_INTERNAL_Dumper($responses)); my %memoized; if ($LONCAPA::CAPAresponse_answer->{'type'} eq 'ordered') { - for (my $i=0; $i{'answers'}[$i]; - my $response = $responselist[$i]; + my $response = $responses->[$i]; my $key = "$answer\0$response"; - $memoized{$key} = [&caparesponse_check($answer, $response)]; + my (@awards,@msgs); + for (my $j=0; $j[$j], + $response->[$j]); + push(@awards,$award); + push(@msgs, $msg); + } + my ($award,$msg) = + &LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); + $memoized{$key} = [$award,$msg]; } } else { - foreach my $response (@responselist) { + #FIXME broken with unorder responses where one is a + # and the other is a (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"; - $memoized{$key} = [&caparesponse_check($answer, $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[$j], + $response->[$j]); + push(@awards,$award); + push(@msgs, $msg); + } + ($award,$msg) = + &LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); + } + $memoized{$key} = [$award,$msg]; } } } my ($final_award,$final_msg); - &init_permutation(scalar(@responselist), + &init_permutation(scalar(@$responses), $LONCAPA::CAPAresponse_answer->{'type'}); # possible FIXMEs @@ -369,17 +430,22 @@ sub caparesponse_check_list { my $order = &get_next_permutation(); my (@awards, @msgs, $i); foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { - my $key = "$thisanswer\0".$responselist[$order->[$i]]; + 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);