--- loncom/homework/default_homework.lcpm 2006/09/29 20:55:33 1.116 +++ loncom/homework/default_homework.lcpm 2019/04/03 21:37:11 1.176 @@ -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.176 2019/04/03 21:37:11 raeburn 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 @@ -142,7 +143,6 @@ sub caparesponse_check { my $sig_lbound=''; #done my $sig_ubound=''; #done - #type's definitons come from capaParser.h #remove leading and trailing whitespace @@ -151,12 +151,10 @@ sub caparesponse_check { } if ($response=~ /^\s|\s$/) { $response=~ s:^\s+|\s+$::g; - &LONCAPA_INTENAL_DEBUG("Removed ws now :$response:"); } - &LONCAPA_INTERNAL_DEBUG(" type is $type "); if ($type eq 'cs' || $type eq 'ci') { - #for string answers make surec all places spaces occur, there is + #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; @@ -165,7 +163,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,10 +173,9 @@ 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"); if ( $answer eq ($answer *1.0)) { $type = 2; } else { $type = 3; } } else { @@ -190,7 +187,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; @@ -198,7 +195,6 @@ sub caparesponse_check { #formula type setup the sample points if ($type eq '8') { ($id_list,$points)=split(/@/,$samples); - &LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples"); } if ($tol eq '') { $tol=0.0; @@ -216,6 +212,13 @@ sub caparesponse_check { my $reterror=""; 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 { @@ -250,115 +253,366 @@ 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); - return ($result,$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="Got response :".join(':',@LONCAPA::CAPAresponse_answer).":\n"; + my $responses=$LONCAPA::CAPAresponse_args{'response'}; &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 $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 (@responselist > $num_answers) { + if (scalar(@$responses) > $num_input_lines) { return 'EXTRA_ANSWER'; } - } else { - (@responselist)=($response); + } - &LONCAPA_INTERNAL_DEBUG("Initial final response :$responselist['-1']:"); + + 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; - if ($type eq '' || $type eq 'float') { + 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; + my $match_algebra = qr{^(.*[^\s])\s+([^\s]+)$}; + # FIXME: with the above regexp, algebra with spaces will not be evaluated correctly + my $match_numerical_units = qr{^([\d\.\,\s\$]*(?:(?:[xX\*]10[\^\*]*|[eE]*)[\+\-]*\d*)*(?:^|\S)\d+)([\$\s\w\^\*\/\(\)\+\-]*[^\d\.\s\,][\$\s\w\^\*\/\(\)\+\-]*)$}; + if ($allowalgebra) { + ($part1,$part2) = ($responses->[0][-1] =~ /$match_algebra/); + } else { + ($part1,$part2) = ($responses->[0][-1] =~ /$match_numerical_units/); + } + 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; + } + } + } + if (scalar(@$responses) > 0 && defined $answerunit) { + # there are several response values, units should be the same for all + $part2 =~ s/^\s+|\s+$//g; + for (my $i=1; $i[$i][-1]; + my ($part1i, $part2i); + if ($allowalgebra) { + ($part1i, $part2i) = ($element =~ /$match_algebra/); + } else { + ($part1i, $part2i) = ($element =~ /$match_numerical_units/); + } + $part2i =~ s/^\s+|\s+$//g; + if (!defined $part2i) { + return 'NO_UNIT'; + } elsif ($part2i ne $part2) { + return ('UNIT_FAIL', "$part2 $part2i"); + } else { + $responses->[$i][-1] = $part1i; + } + } + } } } - &LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:"); $unit=~s/\s//; + 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]; + } + } + } - #&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); + } + + &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'; } - #&reset_caparesponse_memoization(); - return ($final_award,$final_msg); + 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 { @@ -402,16 +656,29 @@ sub hinton { sub random { my ($start,$end,$step)=@_; if ( ! $hidden::RANDOMINIT ) { - if ($external::randomseed == 0) { $external::randomseed=1; } - if ($external::randomseed =~/,/) { - my ($num1,$num2)=split(/,/,$external::randomseed); - &random_set_seed(1,abs($num1)); - } elsif ($external::randomseed =~/:/) { - my ($num1,$num2)=split(/:/,$external::randomseed); - &random_set_seed(abs($num1),abs($num2)); - } else { - &random_set_seed(1,int(abs($external::randomseed))); - } + if ($external::randomseed == 0) { $external::randomseed=1; } + if ($external::randomseed =~/,/) { + my ($num1,$num2) = map { abs($_); } split(/,/,$external::randomseed); + if ((!$num1) || ($num1 > 2147483398)) { + &random_set_seed_from_phrase($external::randomseed); + } else { + &random_set_seed(1,$num1); + } + } elsif ($external::randomseed =~/:/) { + my ($num1,$num2) = map { abs($_); } split(/:/,$external::randomseed); + if ((!$num1) || (!$num2) || ($num1 > 2147483562) || ($num2 > 2147483398)) { + &random_set_seed_from_phrase($external::randomseed); + } else { + &random_set_seed($num1,$num2); + } + } else { + my $num1 = int(abs($external::randomseed)); + if ((!$num1) || ($num1 > 2147483398)) { + &random_set_seed_from_phrase($external::randomseed); + } else { + &random_set_seed(1,$num1); + } + } &math_random_uniform(); $hidden::RANDOMINIT=1; } @@ -586,6 +853,7 @@ 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) } @@ -671,11 +939,19 @@ sub chemparse { my $formula = ''; foreach my $token (@tokens) { if ($token eq '->' ) { - $formula .= '\ensuremath{\rightarrow} '; + if ($external::target eq 'web') { + $formula .= '→ '; + } else { + $formula .= '\ensuremath{\rightarrow} '; + } next; } if ($token eq '<-' ) { - $formula .= '\ensuremath{\leftarrow} '; + if ($external::target eq 'web') { + $formula .= '← '; + } else { + $formula .= '\ensuremath{\leftarrow} '; + } next; } if ($token eq '<=>') { @@ -713,6 +989,18 @@ sub chemparse { return &xmlparse($formula); } +sub conv_eng_format { + my ($ans,$baseunit)=@_; + my ($value,$answer,$unit); + $baseunit =~ s{[^\w/\-\.]}{}g; + eval { + $value = &number_format_pref($ans); + }; + my ($answer,$prefix) = ($value=~ /^(.+)(\w)$/); + my $unit = $prefix.$baseunit; + return($answer,$unit); +} + sub prettyprint { my ($value,$fmt,$target)=@_; my $result; @@ -812,16 +1100,47 @@ sub format_significant_figures { 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))); + 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 { @@ -935,12 +1254,24 @@ 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 ""; @@ -953,40 +1284,159 @@ sub sec { 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 { @@ -1065,3 +1515,8 @@ sub proper_path { } } +sub input_id { + my ($part_id, $response_id, $textline_id) = @_; + return 'HWVAL_'.$part_id.'_'.$response_id.'_'.$textline_id; +} +