--- loncom/homework/default_homework.lcpm 2006/07/05 19:01:44 1.109 +++ loncom/homework/default_homework.lcpm 2006/10/02 18:23:38 1.118 @@ -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.109 2006/07/05 19:01:44 albertel Exp $ +# $Id: default_homework.lcpm,v 1.118 2006/10/02 18:23:38 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,6 +33,72 @@ $pi=atan2(1,1)*4; $rad2deg=180.0/$pi; $deg2rad=$pi/180.0; $"=' '; +use strict; +{ + my $n = 0; + my $total = 0; + my $num_left = 0; + my @order; + my $type; + + sub init_permutation { + my ($size,$requested_type) = @_; + @order = (0..$size-1); + $n = $size; + $type = $requested_type; + if ($type eq 'ordered') { + $total = $num_left = 1; + } elsif ($type eq 'unordered') { + $total = $num_left = &factorial($size); + } else { + die("Unkown type: $type"); + } + } + + sub get_next_permutation { + if ($num_left == $total) { + $num_left--; + return \@order; + } + + # Find largest index j with a[j] < a[j+1] + + my $j = scalar(@order) - 2; + while ($order[$j] > $order[$j+1]) { + $j--; + } + + # Find index k such that a[k] is smallest integer + # greater than a[j] to the right of a[j] + + my $k = scalar(@order) - 1; + while ($order[$j] > $order[$k]) { + $k--; + } + + # Interchange a[j] and a[k] + + @order[($k,$j)] = @order[($j,$k)]; + + # Put tail end of permutation after jth position in increasing order + + my $r = scalar(@order) - 1; + my $s = $j + 1; + + while ($r > $s) { + @order[($s,$r)]=@order[($r,$s)]; + $r--; + $s++; + } + + $num_left--; + return(\@order); + } + + sub get_permutations_left { + return $num_left; + } +} sub check_commas { my ($response)=@_; @@ -60,6 +126,7 @@ sub check_commas { return 1; } + sub caparesponse_check { my ($answer,$response)=@_; #not properly used yet: calc @@ -78,18 +145,17 @@ sub caparesponse_check { #type's definitons come from capaParser.h - my $message=''; + #remove leading and trailing whitespace if (!defined($response)) { $response=''; } if ($response=~ /^\s|\s$/) { $response=~ s:^\s+|\s+$::g; - $message .="Removed ws now :$response:\n"; - } else { - $message .="no ws in :$response:\n"; + #&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 @@ -100,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)) { @@ -110,10 +176,10 @@ 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 '' ) { - $message .= "Didn't find a type :$type: defaulting\n"; + #&LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting"); if ( $answer eq ($answer *1.0)) { $type = 2; } else { $type = 3; } } else { @@ -125,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; @@ -133,7 +199,7 @@ sub caparesponse_check { #formula type setup the sample points if ($type eq '8') { ($id_list,$points)=split(/@/,$samples); - $message.="Found :$id_list:$points: points in $samples\n"; + #&LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples"); } if ($tol eq '') { $tol=0.0; @@ -185,7 +251,9 @@ sub caparesponse_check { elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; } else {$result = "ERROR: Unknown Result:$result:$@:";} - return ("$result:\nRetError $reterror:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message",$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 { @@ -200,9 +268,26 @@ sub capa_formula_fix { sub implicit_multiplication { my ($expression)=@_; - $expression=~s/\s+/\*/g; - $expression=~s/(\d)([a-zA-Z\(])/$1\*$2/g; - $expression=~s/\)(\w)/\)\*$1/g; +# 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; } @@ -212,19 +297,21 @@ sub caparesponse_check_list { &LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args)); my @responselist; my $type = $LONCAPA::CAPAresponse_args{'type'}; - $result.="Got type :$type:\n"; - if ($type ne '' && $#LONCAPA::CAPAresponse_answer > 0) { + &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 < @LONCAPA::CAPAresponse_answer) { + if (@responselist < $num_answers) { return 'MISSING_ANSWER'; } - if (@responselist > @LONCAPA::CAPAresponse_answer) { + if (@responselist > $num_answers) { return 'EXTRA_ANSWER'; } } else { (@responselist)=($response); } - $result.="Initial final response :$responselist['-1']:\n"; + &LONCAPA_INTERNAL_DEBUG("Initial final response :$responselist['-1']:"); my $unit; if ($type eq '' || $type eq 'float') { #for numerical problems split off the unit @@ -233,34 +320,69 @@ sub caparesponse_check_list { $unit=$2; } } - $result.="Final final response :$responselist['-1']:$unit:\n"; + &LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:"); $unit=~s/\s//; - my ($awards, @msgs, $i); - foreach my $thisanswer (@LONCAPA::CAPAresponse_answer) { - my ($msg,$aresult); - $result.="trying answer :$thisanswer:\n"; - if (defined($thisanswer)) { - if ($unit eq '') { - ($aresult,$msg)=&caparesponse_check($thisanswer, - $responselist[$i]); - } else { - ($aresult,$msg)=&caparesponse_check($thisanswer, - $responselist[$i]." $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"; + } + } + + my %memoized; + if ($LONCAPA::CAPAresponse_answer->{'type'} eq 'ordered') { + for (my $i=0; $i{'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)]; } - } else { - $aresult='ERROR'; - $msg='answer was undefined'; } - &LONCAPA_INTERNAL_DEBUG("after if $aresult -- $msg"); - my ($temp)=split(/:/, $aresult); - $awards.="$temp,"; - $result.=$aresult; - push(@msgs,$msg); - $i++; } - chop($awards); - return ("$awards:\n$result",@msgs); + + my ($final_award,$final_msg); + &init_permutation(scalar(@responselist), + $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 $order = &get_next_permutation(); + my (@awards, @msgs, $i); + foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { + my $key = "$thisanswer\0".$responselist[$order->[$i]]; + push(@awards,$memoized{$key}[0]); + push(@msgs,$memoized{$key}[1]); + $i++; + } + my ($possible_award,$possible_msg) = + &LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs); + push(@final_awards,$possible_award); + push(@final_msg,$possible_msg); + } + + my ($final_award,$final_msg) = + &LONCAPA_INTERNAL_FINALIZEAWARDS(\@final_awards,\@final_msg,undef,1); + return ($final_award,$final_msg); } sub tex { @@ -837,6 +959,18 @@ sub class { return $course; } +sub firstname { + my $firstname = &EXT('environment.firstname'); + $firstname = '' if $firstname eq ""; + return $firstname; +} + +sub lastname { + my $lastname = &EXT('environment.lastname'); + $lastname = '' if $lastname eq ""; + return $lastname; +} + sub sec { my $sec = &EXT('request.course.sec'); $sec = '' if $sec eq "";