--- loncom/homework/default_homework.lcpm 2005/02/17 21:42:37 1.92 +++ loncom/homework/default_homework.lcpm 2006/11/10 17:45:52 1.120 @@ -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.92 2005/02/17 21:42:37 albertel Exp $ +# $Id: default_homework.lcpm,v 1.120 2006/11/10 17:45:52 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,25 +145,28 @@ 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:"); } - 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' && $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)) { @@ -106,21 +176,22 @@ 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 { - 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; } - else { return "ERROR: Unknown type of answer: $type" } + else { return ('ERROR', "Unknown type of answer: $type") } } my $points; @@ -128,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; @@ -145,13 +216,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'; } @@ -163,6 +242,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'; } @@ -170,60 +251,204 @@ 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 { + 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 @responselist; + 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 $type = $LONCAPA::CAPAresponse_args{'type'}; - $result.="Got type :$type:\n"; - if ($type ne '' && $#list > 0) { - (@responselist)=split /,/,$response; - } else { - (@responselist)=($response); + &LONCAPA_INTERNAL_DEBUG("Got type :$type:\n"); + + my $num_input_lines = + scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}}); + + if ($type ne '' ) { + if (scalar(@$responses) < $num_input_lines) { + return 'MISSING_ANSWER'; + } + if (scalar(@$responses) > $num_input_lines) { + return 'EXTRA_ANSWER'; + } + + } + + 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(" 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'; + } } - my $unit=''; - $result.="Initial final response :$responselist['-1']:\n"; + + &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; } } - $result.="Final final response :$responselist['-1']:$unit:\n"; - $result.=":$#list: answers\n"; + &LONCAPA_INTERNAL_DEBUG("Final final response :$responses->[0][-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]); - } else { - ($aresult,$msg)=&caparesponse_check($thisanswer, - $responselist[$i]." $unit"); + 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]; + } } - my ($temp)=split /:/, $aresult; - $awards.="$temp,"; - $result.=$aresult; - push(@msgs,$msg); } - chop $awards; - return ("$awards:\n$result",@msgs); + + my ($final_award,$final_msg); + &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 $order = &get_next_permutation(); + my (@awards, @msgs, $i); + foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { + 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); } sub tex { @@ -445,14 +670,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); } @@ -516,10 +741,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; @@ -527,24 +757,33 @@ 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*(?:&frac\d\d)?)(.*)/; + if ($token eq '.') { + $formula =~ s/(\ \;| )$//; + $formula .= '·'; + next; + } + $token =~ /^\s*([\d|\/]*(?:&frac\d\d)?)(.*)/; $formula .= $1 if ($1 ne '1'); # stoichiometric coefficient my $molecule = $2; @@ -556,11 +795,11 @@ sub chemparse { $molecule =~ s/\s*//g; # forced space $molecule =~ s/_/ /g; + $molecule =~ s/-/−/g; $formula .= $molecule.' '; } # get rid of trailing space $formula =~ s/(\ \;| )$//; - if ($external::target eq 'web') { return $formula; } return &xmlparse($formula); } @@ -574,7 +813,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{.}'; @@ -613,12 +856,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; @@ -636,6 +879,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(); @@ -747,6 +1025,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 ""; @@ -831,6 +1121,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)=@_; 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.