--- loncom/homework/default_homework.lcpm 2006/09/29 20:55:33 1.116 +++ loncom/homework/default_homework.lcpm 2006/12/15 22:11:43 1.123 @@ -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.116 2006/09/29 20:55:33 albertel Exp $ +# $Id: default_homework.lcpm,v 1.123 2006/12/15 22:11:43 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -58,7 +58,7 @@ use strict; sub get_next_permutation { if ($num_left == $total) { $num_left--; - return @order; + return \@order; } # Find largest index j with a[j] < a[j+1] @@ -92,7 +92,7 @@ use strict; } $num_left--; - return(@order); + return(\@order); } sub get_permutations_left { @@ -126,6 +126,7 @@ sub check_commas { return 1; } + sub caparesponse_check { my ($answer,$response)=@_; #not properly used yet: calc @@ -151,10 +152,10 @@ sub caparesponse_check { } if ($response=~ /^\s|\s$/) { $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') { #for string answers make surec all places spaces occur, there is #really only 1 space, in both the answer and the response @@ -165,7 +166,7 @@ sub caparesponse_check { $response=~s/[\s,]//g; } if ($type eq 'float' && $unit=~/\$/) { - if ($response!~/^\$/) { return "NO_UNIT: Missing \$ "; } + if ($response!~/^\$/) { return ('NO_UNIT', undef); } $response=~s/\$//g; } if ($type eq 'float' && $unit=~/\,/ && (&check_commas($response)<0)) { @@ -175,7 +176,7 @@ sub caparesponse_check { $unit=~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 '' ) { &LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting"); @@ -190,7 +191,7 @@ sub caparesponse_check { elsif ($type eq 'subj') { $type = 7; } elsif ($type eq 'float') { $type = 2; } elsif ($type eq 'int') { $type = 1; } - else { return "ERROR: Unknown type of answer: $type" } + else { return ('ERROR', "Unknown type of answer: $type") } } my $points; @@ -250,114 +251,169 @@ 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|",$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 { - 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'}}); - if ($type ne '' - && $num_answers > 1) { - (@responselist)=split(/,/,$response); - if (@responselist < $num_answers) { + + my $num_input_lines = + scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}}); + + if ($type ne '' ) { + 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'); + } + } + + +# &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 = $responses->[$i]; + my $key = "$answer\0$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 { + #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"; + 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]; + } + } + } - #&reset_caparesponse_memoization(); my ($final_award,$final_msg); - &init_permutation(scalar(@responselist), + &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 @responses_ordered = @responselist[&get_next_permutation()]; + my $order = &get_next_permutation(); my (@awards, @msgs, $i); foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { - my ($msg,$aresult); - if (defined($thisanswer)) { - my $response = $responses_ordered[$i]; - 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); + 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); - if ($final_award) { - ($final_award,$final_msg) = - &LONCAPA_INTERNAL_FINALIZEAWARDS([$final_award,$possible_award], - [$final_msg,$possible_msg], - undef,1); - } else { - ($final_award,$final_msg) = ($possible_award,$possible_msg); - } + &LONCAPA_INTERNAL_DEBUG(" pos awards ".$possible_award); + push(@final_awards,$possible_award); + push(@final_msg,$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); }