--- loncom/homework/default_homework.lcpm 2005/02/17 23:42:38 1.93 +++ loncom/homework/default_homework.lcpm 2016/12/06 20:51:11 1.171 @@ -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.93 2005/02/17 23:42:38 albertel Exp $ +# $Id: default_homework.lcpm,v 1.171 2016/12/06 20:51:11 damieng 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 @@ -76,27 +143,27 @@ sub caparesponse_check { my $sig_lbound=''; #done my $sig_ubound=''; #done - #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"; } - if ($type eq 'cs' || $type eq 'ci' || $type eq 'mc') { - #for string answers make surec all places spaces occur, there is + + if ($type eq 'cs' || $type eq 'ci') { + #for string answers make sure 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 +173,21 @@ 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"; 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 +195,6 @@ 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"; } if ($tol eq '') { $tol=0.0; @@ -145,13 +211,28 @@ 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') || ($type eq '8')) { + if ($response=~/\=/) { + return ('BAD_FORMULA','Please submit just an expression, not an equation.'); + } elsif ($response =~ /\,/ and $response !~ /^\s*\{.*\}\s*$/) { + return ('BAD_FORMULA'); + } + } + 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 +244,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 +253,342 @@ 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); + return ($result,$reterror); } 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("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); - } - my $unit=''; - $result.="Initial final response :$responselist['-1']:\n"; - if ($type eq '' || $type eq 'float') { + my $answerunit=$LONCAPA::CAPAresponse_args{'unit'}; + &LONCAPA_INTERNAL_DEBUG("Got type :$type: answer unit :$answerunit:\n"); + + my $preprocess=$LONCAPA::CAPAresponse_args{'preprocess'}; + $preprocess=~s/^\&//; + + 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]]; + } + } + 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; + my ($allowalgebra)=($LONCAPA::CAPAresponse_args{'allowalgebra'}=~/^(yes|1|on)$/i); + if ($type eq 'float' || $type eq '') { #for numerical problems split off the unit - if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) { - $responselist['-1']=$1; - $unit=$2; + my $part1; + my $part2; + if ($allowalgebra) { + ($part1,$part2)=($responses->[0][-1]=~ /^(.*[^\s])\s+([^\s]+)$/); + } else { + ($part1,$part2)=($responses->[0][-1]=~ /^([\d\.\,\s\$]*(?:(?:[xX\*]10[\^\*]*|[eE]*)[\+\-]*\d*)*(?:^|\S)\d+)([\$\s\w\^\*\/\(\)\+\-]*[^\d\.\s\,][\$\s\w\^\*\/\(\)\+\-]*)$/); + } + if (defined($part1) && defined($part2)) { + $responses->[0][-1]=$part1; + $unit=&capa_formula_fix($part2); + my $customunits=$LONCAPA::CAPAresponse_args{'customunits'}; + if ($customunits =~ /\S/) { + foreach my $replacement (split(/\s*\,\s*/,$customunits)) { + my ($which,$what)=split(/\s*\=\s*/,$replacement); + if ((defined($which)) && (defined($what))) { + $what=&capa_formula_fix($what); + $unit=~s/$which/\($what\)/g; + } + } + } } } - $result.="Final final response :$responselist['-1']:$unit:\n"; - $result.=":$#list: answers\n"; $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"); + my $error; + foreach my $response (@$responses) { + foreach my $element (@$response) { + # See if we have preprocessor + if ($preprocess=~/\S/) { + if (defined(&$preprocess)) { + no strict 'refs'; + $element=&$preprocess($element,$unit); + use strict 'refs'; + } + } + if (($type eq 'float') || (($type eq '') && ($unit ne ''))) { + $element =~ s/\s//g; + } + my $appendunit=$unit; +# Deal with percentages +# unit is unit entered by student, answerunit is unit by author +# Deprecated: divide answer by 100 if student entered percent, +# but author did not. Too much confusion +# if (($unit=~/\%/) && ($answerunit ne '%')) { +# $element=$element/100; +# $appendunit=~s/\%//; +# } +# Author entered percent, student did not + if (($unit!~/\%/) && ($answerunit=~/\%/)) { + $element=$element*100; + $appendunit='%'.$appendunit; + } +# Zero does not need a dimension + if (($element =~ /^[0\.]+$/) && ($unit!~/\w/) && ($answerunit=~/\w/)) { + $appendunit=$answerunit; + } +# Do the math for the student if allowed + if ($allowalgebra) { + $element=&cas('maxima',$element); + } + if ($appendunit ne '') { + $element .= " $appendunit"; + } + &LONCAPA_INTERNAL_DEBUG("Made response element :$element:"); + } + } + + foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) { + if (!defined($thisanswer)) { + return ('ERROR','answer was undefined'); + } + } + + my $allow_control_char = 0; + my $control_chars_removed = 0; + my $ansstring; + if ($type eq 'cs' || $type eq 'ci') { + if (ref($LONCAPA::CAPAresponse_answer->{'answers'}) eq 'ARRAY') { + foreach my $strans (@{$LONCAPA::CAPAresponse_answer->{'answers'}}) { + if (ref($strans) eq 'ARRAY') { + $ansstring = join("\0",@{$strans}); + foreach my $item (@{$strans}) { + if ($item =~ /[\000-\037]/) { + $allow_control_char = 1; + } + } + } + } + } + } + +# &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] =~ /[\000-\037]/) { + $response->[$j] =~ s/[\000-\037]//g; + $control_chars_removed = 1; + } + } + } + # See if we have preprocessor for string responses + if (($preprocess=~/\S/) && ($type eq 'cs' || $type eq 'ci')) { + if (defined(&$preprocess)) { + no strict 'refs'; + $response->[$j]=&$preprocess($response->[$j]); + use strict 'refs'; + } + } + + my ($award,$msg) = &caparesponse_check($answer->[$j], + $response->[$j]); + if ($type eq 'cs' || $type eq 'ci') { + $error = &verify_stringresponse($type,$award,$response->[$j], + $answer->[$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] =~ /[\000-\037]/) { + $response->[$j] =~ s/[\000-\037]//g; + $control_chars_removed = 1; + } + } + } + # See if we have preprocessor + if (($preprocess=~/\S/) && ($type eq 'cs' || $type eq 'ci')) { + if (defined(&$preprocess)) { + no strict 'refs'; + $response->[$j]=&$preprocess($response->[$j]); + use strict 'refs'; + } + } + + my ($award,$msg) = &caparesponse_check($answer->[$j], + $response->[$j]); + if ($type eq 'cs' || $type eq 'ci') { + $error = &verify_stringresponse($type,$award,$response->[$j], + $answer->[$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(@$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++; + } - my ($temp)=split /:/, $aresult; - $awards.="$temp,"; - $result.=$aresult; - push(@msgs,$msg); + &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,$error,$control_chars_removed,$ansstring); +} + +sub verify_stringresponse { + my ($type,$award,$resp,$ans) = @_; + return if ($award eq 'EXACT_ANS'); + my $error; + if ($resp =~ /^\s|\s$/) { + $resp =~ s{^\s+|\s+$}{}g; + } + if ($ans =~ /^\s|\s$/) { + $ans =~ s{^\s+|\s+$}{}g; + } + if ($type eq 'ci') { + $resp = lc($resp); + $ans = lc($ans); + } + if ($resp eq $ans) { + if ($award eq 'INCORRECT') { + $error = 'MISGRADED'; + } + } + return $error; +} + +sub cas { + my ($system,$input,$library)=@_; + my $output; + my $dump; + if ($system eq 'maxima') { + $output=&maxima_eval($input,$library); + } elsif ($system eq 'R') { + ($output,$dump)=&r_eval($input,$library,0); + } else { + $output='Error: unrecognized CAS'; } - chop $awards; - return ("$awards:\n$result",@msgs); + return $output; +} + +sub cas_hashref { + my ($system,$input,$library)=@_; + if ($system eq 'maxima') { + return 'Error: unsupported CAS'; + } elsif ($system eq 'R') { + return &r_eval($input,$library,1); + } else { + return 'Error: unrecognized CAS'; + } +} + +# +# cas_hashref_entry takes a list of indices and gets the entry in a hash generated by Rreturn. +# Call: cas_hashref_entry(Rvalue, index1, index2, ...) where Rvalue is a hash returned by Rreturn. +# Rentry will return the first scalar value it encounters (ignoring excess indices). +# If an invalid key is given, it returns undef. +# +sub cas_hashref_entry { + return &Rentry(@_); +} + +# +# cas_hashref_array takes a list of indices and gets a column array from a hash generated by Rreturn. +# Call: cas_hashref_array(Rvalue, index1, index2, ...) where Rvalue is a hash returned by Rreturn. +# If an invalid key is given, it returns undef. +# +sub cas_hashref_array { + return &Rarray(@_); } sub tex { @@ -445,14 +810,15 @@ 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 ln { 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 +882,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 +898,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,6 +936,7 @@ sub chemparse { $molecule =~ s/\s*//g; # forced space $molecule =~ s/_/ /g; + $molecule =~ s/-/−/g; $formula .= $molecule.' '; } # get rid of trailing space @@ -573,7 +954,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{.}'; @@ -612,12 +997,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; @@ -635,6 +1020,72 @@ 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); + if ($numSig =~ /^(\d+)\.(\d+)/) { + # insert trailing zero's if have decimal point + my @digarray = split('',$1.$2); + my $sigcount; + while (@digarray > 0) { + my $item = shift(@digarray); + if ($item) { + $sigcount = 1 + @digarray; + last; + } + } + if (($sigcount) && ($sig >= $sigcount)) { + $zeros = substr($zeros,0,($sig - $sigcount)); + } + $numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/; + } else { + if ($numSig =~ /^(\d+)e([\+\-]\d+)$/i) { + my $pre_exp = $1; + my $exponent = $2; + $numSig = $pre_exp.'.'.$zeros.'E'.$exponent; + } elsif ($numSig =~ /0$/) { + # add decimal pt for number ending with 0 and length == # of sig figs + if (length($numSig) == $sig) { + $numSig.='.'; + } elsif (length($numSig) > $sig) { + # exponential form for number ending with 0 and length > # of sig figs + my $fmtsig = $sig-1; + if ($fmtsig) { + $numSig = sprintf('%.'.$fmtsig.'E',$numSig); + } + } elsif (length($numSig) < $sig) { + $numSig.='.'.substr($zeros,0,($sig-length($numSig))); + } + } else { + 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(); @@ -746,46 +1197,189 @@ sub class { return $course; } +sub classid { + my $courseid = &EXT('request.course.id'); + $courseid = '' if $courseid eq ""; + return $courseid; +} + +sub firstname { + my $firstname = &EXT('environment.firstname'); + $firstname = '' if $firstname eq ""; + return $firstname; +} + +sub middlename { + my $middlename = &EXT('environment.middlename'); + $middlename = '' if $middlename eq ""; + return $middlename; +} + +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 ""; return $sec; } -sub open_date { - my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate'))); - return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969); - my @hm = split(/:/,$dc[3]); - my $ampm = " am"; - if ($hm[0] > 12) { - $hm[0]-=12; - $ampm = " pm"; - } - return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm; -} - -sub due_date { - my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate'))); - return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969); - my @hm = split(/:/,$dc[3]); - my $ampm = " am"; - if ($hm[0] > 12) { - $hm[0]-=12; - $ampm = " pm"; +sub submission { + my ($partid,$responseid,$subnumber,$encode,$cleanupnum,$mapalias)=@_; + my $sub=''; + if ($subnumber) { $sub=$subnumber.':'; } + my $output = + &EXT('user.resource.'.$sub.'resource.'.$partid.'.'.$responseid.'.submission',$mapalias); + if (ref($output) eq 'ARRAY') { + my @items = @{$output}; + if ($encode) { + @items = map { &encode_response($_); } @items; + } + if (ref($cleanupnum) eq 'HASH') { + @items = map { &cleanup_numerical_response($cleanupnum,$_); } @items; + } + return \@items; + } else { + if ($encode) { + $output = &encode_response($output); + } + if (ref($cleanupnum) eq 'HASH') { + $output = &cleanup_numerical_response($cleanupnum,$output); + } + return $output; + } +} + +sub encode_response { + my ($value) = @_; + $value =~ s/&/&/g; + $value =~ s//>/g; + $value =~ s/"/"/g; + return $value; +} + +sub cleanup_numerical_response { + my ($cleanupnum,$value) = @_; + if (ref($cleanupnum) eq 'HASH') { + if ($cleanupnum->{exponent}) { + if ($value =~ m{^(.*)[\*xX]\s*10\s*\^\s*(\+|\-)?\s*(\d+)(.*)$}) { + my $pre_exp = $1; + my $sign = $2; + my $exponent = $3; + my $post_exp = $4; + if ($pre_exp !~ /\./) { + $pre_exp .= '.'; + } + if ($sign eq '') { + $sign = '+'; + } + $value = $pre_exp.'E'.$sign.$exponent.$post_exp; + } + } + if ($cleanupnum->{comma}) { + $value =~ s{(\d+),(\d+)}{$1$2}; + } + if ($cleanupnum->{letterforzero}) { + $value =~ s/^\s*o(\.\d+)/0$1/i; + } + if ($cleanupnum->{spaces}) { + $value =~ s{^\s+|\s+$}{}g; + if ($value =~ m{^(.*)\.\s+(\d+)(.*)$}) { + my $pre_pt = $1; + my $decimal = $2; + my $post_dec = $3; + $value = $pre_pt.'.'.$decimal.$post_dec; + } + } + if ($cleanupnum->{format} =~ /^\d+s$/i) { + $value = &format_significant_figures($value,$cleanupnum->{format}); + } } - return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm; + return $value; +} + +sub currentpart { + return $external::part; +} + +sub eval_time { + my ($timestamp)=@_; + unless ($timestamp) { return ''; } + return &locallocaltime($timestamp); +} + +sub open_date { + my ($partid)=@_; + unless ($partid) { $partid=0; } + return &eval_time(&EXT('resource.'.$partid.'.opendate')); +} + +sub due_date { + my ($partid)=@_; + unless ($partid) { $partid=0; } + return &eval_time(&EXT('resource.'.$partid.'.duedate')); } sub answer_date { - my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate'))); - return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969); - my @hm = split(/:/,$dc[3]); - my $ampm = " am"; - if ($hm[0] > 12) { - $hm[0]-=12; - $ampm = " pm"; + my ($partid)=@_; + unless ($partid) { $partid=0; } + return &eval_time(&EXT('resource.'.$partid.'.answerdate')); +} + +sub open_date_epoch { + my ($partid)=@_; + unless ($partid) { $partid=0; } + return &EXT('resource.'.$partid.'.opendate'); +} + +sub due_date_epoch { + my ($partid)=@_; + unless ($partid) { $partid=0; } + return &EXT('resource.'.$partid.'.duedate'); +} + +sub answer_date_epoch { + my ($partid)=@_; + unless ($partid) { $partid=0; } + return &EXT('resource.'.$partid.'.answerdate'); +} + +sub parameter_setting { + my ($which,$partid)=@_; + unless ($partid) { $partid=0; } + return &EXT('resource.'.$partid.'.'.$which); +} + +sub stored_data { + my ($which,$partid)=@_; + unless ($partid) { $partid=0; } + return &EXT('user.resource.resource.'.$partid.'.'.$which); +} + +sub wrong_bubbles { + my ($correct,$lower,$upper,$step,@given)=@_; + my @array=(); + my %hash=(); + foreach my $new (@given) { + $hash{$new}=1; } - return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm; + my $num=int(¶meter_setting('numbubbles',¤tpart())); + unless ($num) { $num=8; } + if ($num>1) { + for (my $i=0;$i<=500;$i++) { + my $new=&random($lower,$upper,$step); + if ($hash{$new}) { next; } + if (abs($new-$correct)<$step) { next; } + $hash{$new}=1; + @array=keys(%hash); + if ($#array+2>=$num) { last; } + } + } + return @array; } sub array_moments { @@ -830,6 +1424,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)=@_; @@ -840,3 +1458,8 @@ sub proper_path { } } +sub input_id { + my ($part_id, $response_id, $textline_id) = @_; + return 'HWVAL_'.$part_id.'_'.$response_id.'_'.$textline_id; +} +