--- loncom/homework/default_homework.lcpm 2004/10/05 20:30:17 1.89 +++ loncom/homework/default_homework.lcpm 2006/09/29 20:55:33 1.116 @@ -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.89 2004/10/05 20:30:17 albertel Exp $ +# $Id: default_homework.lcpm,v 1.116 2006/09/29 20:55:33 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,6 +33,98 @@ $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)=@_; + #print("$response "); + my @numbers=split(',',$response); + #print(" numbers ".join('-',@numbers)." "); + if (scalar(@numbers) > 1) { + #print(" numbers[0] ".$numbers[0]." "); + if (length($numbers[0]) > 3 || length($numbers[0]) == 0) { return -1; } + shift(@numbers); + #print(" numbers ".scalar(@numbers)." "); + while (scalar(@numbers) > 1) { + #print(" numbers ".join('-',@numbers)." "); + if (length($numbers[0]) != 3) { return -2; } + shift(@numbers); + } + my ($number)=split('\.',$numbers[0]); + #print(" number ".$number." "); + #print(" numbers[0] ".$numbers[0]." "); + if (length($number) != 3) { return -3; } + } else { + my ($number)=split('\.',$numbers[0]); + if (length($number) > 3) { return -4; } + } + return 1; +} sub caparesponse_check { my ($answer,$response)=@_; @@ -52,41 +144,49 @@ 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_INTENAL_DEBUG("Removed ws now :$response:"); } - if ($type eq 'cs' || $type eq 'ci' || $type eq 'mc') { + + &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 $answer=~s/ +/ /g; $response=~s/ +/ /g; + } elsif ($type eq 'mc') { + $answer=~s/[\s,]//g; + $response=~s/[\s,]//g; } - if ($type eq 'float') { $response=~s/,//g; } - if ($type eq 'float' && $ans_fmt=~/\$/) { + if ($type eq 'float' && $unit=~/\$/) { if ($response!~/^\$/) { return "NO_UNIT: Missing \$ "; } $response=~s/\$//g; } + if ($type eq 'float' && $unit=~/\,/ && (&check_commas($response)<0)) { + return "COMMA_FAIL:"; + } $ans_fmt=~s/\W//g; + $unit=~s/[\$,]//g; + if ($type eq 'float') { $response=~s/,//g; } if (length($response) > 500) { return "TOO_LONG: Answer too long"; } 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 { - if ($type eq 'cs') { $type = 4; } + if ($type eq 'cs') { $type = 4; } elsif ($type eq 'ci') { $type = 3 } elsif ($type eq 'mc') { $type = 5; } elsif ($type eq 'fml') { $type = 8; } + elsif ($type eq 'math') { $type = 9; } elsif ($type eq 'subj') { $type = 7; } elsif ($type eq 'float') { $type = 2; } elsif ($type eq 'int') { $type = 1; } @@ -98,7 +198,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; @@ -115,13 +215,21 @@ sub caparesponse_check { ($sig_ubound,$sig_lbound)=&LONCAPA_INTERNAL_get_sigrange($sig); my $reterror=""; - my $result = &caparesponse_capa_check_answer($response,$answer,$type, + my $result; + if ($type eq '9') { + $result = &maxima_check(&maxima_cas_formula_fix($response),&maxima_cas_formula_fix($answer),\$reterror); + } else { + if ($type eq '8') { # fml type + $response = &capa_formula_fix($response); + $answer = &capa_formula_fix($answer); + } + $result = &caparesponse_capa_check_answer($response,$answer,$type, $tol_type,$tol, $sig_lbound,$sig_ubound, $ans_fmt,$unit,$calc,$id_list, $points,$external::randomseed, \$reterror); - + } if ($result == '1') { $result='EXACT_ANS'; } elsif ($result == '2') { $result='APPROX_ANS'; } elsif ($result == '3') { $result='SIG_FAIL'; } @@ -133,6 +241,8 @@ sub caparesponse_check { elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; } elsif ($result =='10') { $result='SUB_RECORDED'; } elsif ($result =='11') { $result='BAD_FORMULA'; } + elsif ($result =='12' && !$response) { $result='MISSING_ANSWER'; } + elsif ($result =='12') { $result='WANTED_NUMERIC'; } elsif ($result =='13') { $result='UNIT_INVALID_INSTRUCTOR'; } elsif ($result =='141') { $result='UNIT_INVALID_STUDENT'; } elsif ($result =='142') { $result='UNIT_INVALID_STUDENT'; } @@ -140,29 +250,67 @@ 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|",$reterror); + 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,@list); - @list=@LONCAPA::CAPAresponse_answer; - my $aresult=''; - my $current_answer; - my $answers=join(':',@list); - $result.="Got response :$answers:\n"; - &LONCAPA_INTERNAL_DEBUG("Yo! got ".join(':',%LONCAPA::CAPAresponse_args)); + my $result="Got response :".join(':',@LONCAPA::CAPAresponse_answer).":\n"; + &LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args)); my @responselist; my $type = $LONCAPA::CAPAresponse_args{'type'}; - $result.="Got type :$type:\n"; - if ($type ne '' && $#list > 0) { - (@responselist)=split /,/,$response; + &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) { + return 'MISSING_ANSWER'; + } + if (@responselist > $num_answers) { + return 'EXTRA_ANSWER'; + } } else { (@responselist)=($response); } - my $unit=''; - $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 if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) { @@ -170,30 +318,47 @@ sub caparesponse_check_list { $unit=$2; } } - $result.="Final final response :$responselist['-1']:$unit:\n"; - $result.=":$#list: answers\n"; + &LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:"); $unit=~s/\s//; - my $i=0; - my $awards=''; - my @msgs; - for ($i=0; $i<@list;$i++) { - my $msg; - $result.="trying answer :$list[$i]:\n"; - my $thisanswer=$list[$i]; - $result.="trying answer :$thisanswer:\n"; - if ($unit eq '') { - ($aresult,$msg)=&caparesponse_check($thisanswer,$responselist[$i]); + + #&reset_caparesponse_memoization(); + my ($final_award,$final_msg); + &init_permutation(scalar(@responselist), + $LONCAPA::CAPAresponse_answer->{'type'}); + while( &get_permutations_left() ) { + my @responses_ordered = @responselist[&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); + $i++; + } + 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 { - ($aresult,$msg)=&caparesponse_check($thisanswer, - $responselist[$i]." $unit"); + ($final_award,$final_msg) = ($possible_award,$possible_msg); } - my ($temp)=split /:/, $aresult; - $awards.="$temp,"; - $result.=$aresult; - push(@msgs,$msg); } - chop $awards; - return ("$awards:\n$result",@msgs); + #&reset_caparesponse_memoization(); + return ($final_award,$final_msg); } sub tex { @@ -415,14 +580,14 @@ sub random_negative_binomial { return @retArray; } -sub abs { abs(shift) } -sub sin { sin(shift) } -sub cos { cos(shift) } -sub exp { exp(shift) } -sub int { int(shift) } -sub log { log(shift) } -sub atan2 { atan2($_[0],$_[1]) } -sub sqrt { sqrt(shift) } +sub abs { CORE::abs(shift) } +sub sin { CORE::sin(shift) } +sub cos { CORE::cos(shift) } +sub exp { CORE::exp(shift) } +sub int { CORE::int(shift) } +sub log { CORE::log(shift) } +sub atan2 { CORE::atan2($_[0],$_[1]) } +sub sqrt { CORE::sqrt(shift) } sub tan { CORE::sin($_[0]) / CORE::cos($_[0]) } #sub atan { atan2($_[0], 1); } @@ -486,10 +651,15 @@ sub format { #if ($options =~ /\$/) { $dollamode=1; } #if ($options =~ /,/) { $commamode=1; } if ($options =~ /\./) { $alwaysperiod=1; } - $fmt=~s/e/E/g; - my $result=sprintf('%.'.$fmt,$value); - if ($alwaysperiod && $fmt eq '0f') { $result .='.'; } - $result=~s/(E[+-]*)0/$1/; + my $result; + if ($fmt=~/s$/i) { + $result=&format_significant_figures($value,$fmt); + } else { + $fmt=~s/e/E/g; + $result=sprintf('%.'.$fmt,$value); + if ($alwaysperiod && $fmt eq '0f') { $result .='.'; } + $result=~s/(E[+-]*)0/$1/; + } #if ($dollarmode) {$result=&dollarformat($result);} #if ($commamode) {$result=&commaformat($result);} return $result; @@ -497,25 +667,34 @@ sub format { sub chemparse { my ($reaction) = @_; - my @tokens = split(/(\s\+|\->|<=>)/,$reaction); + my @tokens = split(/(\s\+|\->|<=>|<\-|\.)/,$reaction); my $formula = ''; foreach my $token (@tokens) { if ($token eq '->' ) { $formula .= '\ensuremath{\rightarrow} '; next; } + if ($token eq '<-' ) { + $formula .= '\ensuremath{\leftarrow} '; + next; + } if ($token eq '<=>') { if ($external::target eq 'web' && &EXT('request.browser.unicode')) { $formula .= '⇌ '; } else { $formula .= &web('<=> ','\ensuremath{\rightleftharpoons} ', - '<=$gt; '); + '<=> '); } next; } - $token =~ /^\s*(\d*)(.*)/; - $formula .= $1 if ($1 > 1); # stoichiometric coefficient + if ($token eq '.') { + $formula =~ s/(\ \;| )$//; + $formula .= '·'; + next; + } + $token =~ /^\s*([\d|\/]*(?:&frac\d\d)?)(.*)/; + $formula .= $1 if ($1 ne '1'); # stoichiometric coefficient my $molecule = $2; # subscripts @@ -526,11 +705,11 @@ sub chemparse { $molecule =~ s/\s*//g; # forced space $molecule =~ s/_/ /g; + $molecule =~ s/-/−/g; $formula .= $molecule.' '; } # get rid of trailing space $formula =~ s/(\ \;| )$//; - return &xmlparse($formula); } @@ -544,7 +723,11 @@ sub prettyprint { if ($options =~ /\$/) { $dollarmode=1; } if ($options =~ /,/) { $commamode=1; } if ($options =~ /\./) { $alwaysperiod=1; } - if ($fmt) { $value=sprintf('%.'.$fmt,$value); } + if ($fmt=~/s$/i) { + $value=&format_significant_figures($value,$fmt); + } elsif ($fmt) { + $value=sprintf('%.'.$fmt,$value); + } if ($alwaysperiod && $fmt eq '0f') { if ($target eq 'tex') { $value .='\\ensuremath{.}'; @@ -583,12 +766,12 @@ sub prettyprint { sub commaformat { my ($number,$target) = @_; if ($number =~ /\./) { - while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) { - $number = $1.','.$2.$3; + while ($number =~ /([^0-9]*)([0-9]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) { + $number = $1.$2.','.$3.$4; } } else { - while ($number =~ /([^,]+)([^,][^,][^,])([,0-9]*)$/) { - $number = $1.','.$2.$3; + while ($number =~ /^([^0-9]*)([0-9]+)([^,][^,][^,])([,0-9]*)$/) { + $number = $1.$2.','.$3.$4; } } return $number; @@ -606,6 +789,41 @@ sub dollarformat { return $number; } +# format of form ns or nS where n is an integer +sub format_significant_figures { + my ($number,$format) = @_; + return '0' if ($number == 0); + # extract number of significant figures needed + my ($sig) = ($format =~ /(\d+)s/i); + # arbitrary choice - suggestions ?? or throw error message? + $sig = 3 if ($sig eq ''); + # save the minus sign + my $sign = ($number < 0) ? '-' : ''; + $number = abs($number); + # needed to correct for a number greater than 1 (or + my $power = ($number < 1) ? 0 : 1; + # could round up. Take the integer part of log10. + my $x10 = int(log($number)/log(10)); + # find number with values left of decimal pt = # of sign figs. + my $xsig = $number*10**($sig-$x10-$power); + # get just digits left of decimal pt - also rounds off correctly + my $xint = sprintf('%.0f',$xsig); + # save any trailing zero's + my ($zeros) = ($xint =~ /(0+)$/); + # return number to original magnitude + my $numSig = $xint*10**($x10-$sig+$power); + # insert trailing zero's if have decimal point + $numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/; + # put a decimal pt for number ending with 0 and length = # of sig fig + $numSig.='.' if (length($numSig) == $sig && $numSig =~ /0$/); + if (length($numSig) < $sig) { + $numSig.='.'.substr($zeros,0,($sig-length($numSig))); + } + # return number with sign + return $sign.$numSig; + +} + sub map { my ($phrase,$dest,$source)=@_; my @oldseed=&random_get_seed(); @@ -717,6 +935,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 ""; @@ -801,6 +1031,30 @@ sub choose { return $_[$num]; } +#&sum1(1,$x,sub { &sum1($_[0],2*$_[0], sub { fact($_[0])**2 })}); +#sub sum1 { +# my ($start,$end,$sub)=@_; +# my $sum=0; +# for (my $i=$start;$i<=$end;$i++) { +# $sum+=&$sub($i); +# } +# return $sum +#} + +#&sum2('a',1,$x,'&sum2(\'b\',$a,2*$a, \'&factorial($b)**2\')'); +#sub sum2 { +# my ($varname,$start,$end,$line)=@_; +# my $sum=0; +# for (my $i=$start;$i<=$end;$i++) { +# my $func=sub { +# eval("\$".$varname."=$i"); +# eval($line); +# }; +# $sum+=&$func($i); +# } +# return $sum +#} + # expiremental idea sub proper_path { my ($path)=@_;