--- loncom/homework/default_homework.lcpm 2002/05/31 22:19:06 1.47 +++ loncom/homework/default_homework.lcpm 2004/03/12 21:06:19 1.71 @@ -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.47 2002/05/31 22:19:06 albertel Exp $ +# $Id: default_homework.lcpm,v 1.71 2004/03/12 21:06:19 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -42,14 +42,14 @@ $"=' '; sub caparesponse_check { #not properly used yet: calc #not to be used: $ans_fmt - my ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc,$samples) = - eval $_[1]. - ';return ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc,$samples);'; + my ($type,$tol,$sig,$ans_fmt,$unit,$calc,$samples) = + eval $_[2]. + ';return ($__LC__type,$__LC__tol,$__LC__sig,$__LC__ans_fmt,$__LC__unit,$__LC__calc,$__LC__samples);'; my $tol_type=''; # gets it's value from whether tol has a % or not done my $sig_lbound=''; #done my $sig_ubound=''; #done - my ($response,$expr)=@_; + my ($answer,$response,$expr)=@_; #type's definitons come from capaParser.h @@ -57,13 +57,15 @@ sub caparesponse_check { #remove leading and trailing whitespace if ($response=~ /^\s|\s$/) { $response=~ s:^\s+|\s+$::g; - $message .="Removed ws now :$response:
"; + $message .="Removed ws now :$response:\n"; } else { - $message .="no ws in :$response:
"; + $message .="no ws in :$response:\n"; } + if (length($response) > 500) { return "TOO_LONG: Answer too long"; } + if ($type eq '' ) { - $message .= "Didn't find a type :$type:$expr: defaulting
"; + $message .= "Didn't find a type :$type:$expr: defaulting\n"; if ( $answer eq ($answer *1.0)) { $type = 2; } else { $type = 3; } } else { @@ -82,7 +84,7 @@ sub caparesponse_check { #formula type setup the sample points if ($type eq '8') { ($id_list,$points)=split(/@/,$samples); - $message.="Found :$points: points
"; + $message.="Found :$id_list:$points: points in $samples\n"; } if ($tol eq '') { $tol=0.0; @@ -101,17 +103,19 @@ sub caparesponse_check { $sig_ubound =15; #SIG_UB_DEFAULT } else { ($sig_lbound,$sig_ubound) = split /,/,$sig; - if (!$sig_lbound) { + if (!defined($sig_lbound)) { $sig_lbound = 0; #SIG_LB_DEFAULT $sig_ubound =15; #SIG_UB_DEFAULT } - if (!$sig_ubound) { $sig_ubound=$sig_lbound; } + if (!defined($sig_ubound)) { $sig_ubound=$sig_lbound; } } + my $reterror=""; my $result = &caparesponse_capa_check_answer($response,$answer,$type, $tol_type,$tol, $sig_lbound,$sig_ubound, $ans_fmt,$unit,$calc,$id_list, - $points,$external::randomseed); + $points,$external::randomseed, + \$reterror); if ($result == '1') { $result='EXACT_ANS'; } elsif ($result == '2') { $result='APPROX_ANS'; } @@ -127,23 +131,23 @@ sub caparesponse_check { elsif ($result =='12') { $result='WANTED_NUMERIC'; } else {$result = "ERROR: Unknown Result:$result:$@:";} - return "$result:
Error $error:
Answer $answer:
Response $response:
type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|
$message$expr"; + return ("$result:\nRetError $reterror:\nError $error:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message$expr",$reterror); } sub get_array_args { my ($expr,$arg)=@_; # do these first, because who knows what varname the instructor might have used # but it probably isn't $CAPARESPONSE_CHECK_LIST_answer - my $CAPARESPONSE_CHECK_LIST_answer = eval $expr.';return $'.$arg; #' - my $GET_ARRAY_ARGS_result; + my $CAPARESPONSE_CHECK_LIST_answer = eval $expr.';return $'.$arg; #' stupid emacs + my $GET_ARRAY_ARGS_result="expr is $expr\narg is $arg\nfirst answer guess is $CAPARESPONSE_CHECK_LIST_answer\n"; my @GET_ARRAY_ARGS_list; if ($CAPARESPONSE_CHECK_LIST_answer =~ /^\s*[\$\@]/) { (@GET_ARRAY_ARGS_list) = eval $CAPARESPONSE_CHECK_LIST_answer; } - $GET_ARRAY_ARGS_result.="error:$@:
"; + $GET_ARRAY_ARGS_result.="error:$@:\n"; # if the eval fails just use what is in the answer exactly - if (!defined(@GET_ARRAY_ARGS_list) || !defined($GET_ARRAY_ARGS_list[0])) { - $GET_ARRAY_ARGS_result.="list zero is undefined
"; + if (!(@GET_ARRAY_ARGS_list) || !defined($GET_ARRAY_ARGS_list[0])) { + $GET_ARRAY_ARGS_result.="list zero is undefined\n"; $GET_ARRAY_ARGS_list[0]=$CAPARESPONSE_CHECK_LIST_answer; } return $GET_ARRAY_ARGS_result,@GET_ARRAY_ARGS_list; @@ -151,61 +155,75 @@ sub get_array_args { sub caparesponse_check_list { my ($response,$expr)=@_; - my $result; - my ($result,@list) = &get_array_args($expr,'answer'); +# $expr =~ s/\\/\\\\/g; +# $expr =~ s/\'/\\\'/g; +# my ($result,@list) = &get_array_args($expr,'answer'); +# $expr =~ s/\\\'/\'/g; +# $expr =~ s/\\\\/\\/g; + my ($result,@list); + @list=@CAPARESPONSE_CHECK_LIST_answer; my $aresult=''; my $current_answer; my $answers=join(':',@list); - $result.="Got response :$answers:
"; + $result.="Got response :$answers:\n"; my @responselist; - my $type =eval $expr.';return $answer;'; + my $type =eval $expr.';return $__LC__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']:
"; - if ($type eq '') { + $result.="Initial final response :$responselist['-1']:\n"; + if ($type eq '' || $type eq 'float') { #for numerical problems split off the unit if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) { $responselist['-1']=$1; $unit=$2; } } - $result.="Final final response :$responselist['-1']:
"; - $result.=":$#list: answers
"; + $result.="Final final response :$responselist['-1']:\n"; + $result.=":$#list: answers\n"; $unit=~s/\s//; my $i=0; my $awards=''; + my @msgs; for ($i=0; $i<@list;$i++) { - $result.="trying answer :$list[$i]:
"; + my $msg; + $result.="trying answer :$list[$i]:\n"; + my $thisanswer=$list[$i]; +# $thisanswer=~ s/\\/\\\\/g; +# $thisanswer =~ s/\'/\\\'/g; + $result.="trying answer :$thisanswer:\n"; if ($unit eq '') { - $aresult=&caparesponse_check($responselist[$i], - $expr.';my $answer=\''.$list[$i].'\';'); + ($aresult,$msg)=&caparesponse_check($thisanswer,$responselist[$i], + $expr); } else { - $aresult=&caparesponse_check($responselist[$i]." $unit", - $expr.';my $answer=\''.$list[$i].'\';'); + ($aresult,$msg)=&caparesponse_check($thisanswer, + $responselist[$i]." $unit", + $expr); } my ($temp)=split /:/, $aresult; $awards.="$temp,"; $result.=$aresult; + push(@msgs,$msg); } chop $awards; - return "$awards:
$result"; + return ("$awards:\n$result",@msgs); } sub tex { if ( $external::target eq "tex" ) { - return @_[0]; + return $_[0]; } else { - return @_[1]; + return $_[1]; } } sub var_in_tex { if ( $external::target eq "tex" ) { - return @_[0]; + return $_[0]; } else { return ""; } @@ -213,12 +231,12 @@ sub var_in_tex { sub web { if ( $external::target eq "tex" ) { - return @_[1]; + return $_[1]; } else { if ( $external::target eq "web" || $external::target eq "answer") { - return @_[2]; + return $_[2]; } else { - return @_[0]; + return $_[0]; } } } @@ -229,150 +247,185 @@ sub html { } } -sub problem { - return '1'; -} - sub hinton { return 0; } sub random { - my ($start,$end,$step)=@_; - if ( ! $hidden::RANDOMINIT ) { - srand($external::randomseed); - $hidden::RANDOMINIT=1; - } - if (!defined($step)) { $step=1; } - my $num=1+int(($end-$start)/$step); - my $result=$start + int(rand() * $num)*$step; - return $result; + my ($start,$end,$step)=@_; + if ( ! $hidden::RANDOMINIT ) { + if ($external::randomseed == 0) { $external::randomseed=1; } + if ($external::randomseed =~/,/) { + my ($num1,$num2)=split(/,/,$seed); + &random_set_seed(abs($num1),abs($num2)); + } else { + &random_set_seed(1,int(abs($external::randomseed))); + } + &math_random_uniform(); + $hidden::RANDOMINIT=1; + } + if (!defined($step)) { $step=1; } + my $num=1+int(($end-$start)/$step); + my $result=$start + int(&math_random_uniform() * $num)*$step; + return $result; } sub random_normal { my ($item_cnt,$seed,$av,$std_dev) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_normal($item_cnt,$av,$std_dev); + &random_set_seed(@oldseed); return @retArray; } sub random_beta { my ($item_cnt,$seed,$aa,$bb) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_beta($item_cnt,$aa,$bb); + &random_set_seed(@oldseed); return @retArray; } sub random_gamma { my ($item_cnt,$seed,$a,$r) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_gamma($item_cnt,$a,$r); + &random_set_seed(@oldseed); return @retArray; } sub random_exponential { my ($item_cnt,$seed,$av) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_exponential($item_cnt,$av); + &random_set_seed(@oldseed); return @retArray; } sub random_poisson { my ($item_cnt,$seed,$mu) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_poisson($item_cnt,$mu); + &random_set_seed(@oldseed); return @retArray; } sub random_chi { my ($item_cnt,$seed,$df) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_chi_square($item_cnt,$df); + &random_set_seed(@oldseed); return @retArray; } sub random_noncentral_chi { my ($item_cnt,$seed,$df,$nonc) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc); + &random_set_seed(@oldseed); return @retArray; } sub random_f { my ($item_cnt,$seed,$dfn,$dfd) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_f($item_cnt,$dfn,$dfd); + &random_set_seed(@oldseed); return @retArray; } sub random_noncentral_f { my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc); + &random_set_seed(@oldseed); return @retArray; } sub random_multivariate_normal { my ($item_cnt,$seed,$mean,$covar) = @_; + my @oldseed=&random_get_seed(); &random_set_seed_from_phrase($seed); @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar); + &random_set_seed(@oldseed); return @retArray; } sub random_multinomial { my ($item_cnt,$seed,@p) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_multinomial($item_cnt,@p); + &random_set_seed(@oldseed); return @retArray; } sub random_permutation { my ($seed,@inArray) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_permutation(@inArray); + &random_set_seed(@oldseed); return @retArray; } sub random_uniform { my ($item_cnt,$seed,$low,$high) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_uniform($item_cnt,$low,$high); + &random_set_seed(@oldseed); return @retArray; } sub random_uniform_integer { my ($item_cnt,$seed,$low,$high) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_uniform_integer($item_cnt,$low,$high); + &random_set_seed(@oldseed); return @retArray; } sub random_binomial { my ($item_cnt,$seed,$nt,$p) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_binomial($item_cnt,$nt,$p); + &random_set_seed(@oldseed); return @retArray; } sub random_negative_binomial { my ($item_cnt,$seed,$ne,$p) = @_; + my @oldseed=&random_get_seed(); my @retArray; &random_set_seed_from_phrase($seed); @retArray=&math_random_negative_binomial($item_cnt,$ne,$p); + &random_set_seed(@oldseed); return @retArray; } @@ -385,15 +438,15 @@ sub log { log(shift) } sub atan2 { atan2($_[0],$_[1]) } sub sqrt { sqrt(shift) } -sub tan { sin($_[0]) / cos($_[0]) } +sub tan { CORE::sin($_[0]) / CORE::cos($_[0]) } #sub atan { atan2($_[0], 1); } #sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); } #sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) ); } -sub log10 { log($_[0])/log(10); } +sub log10 { CORE::log($_[0])/CORE::log(10); } sub factorial { - my $input = int(shift); + my $input = CORE::int(shift); return "Error - unable to take factorial of an negative number ($input)" if $input < 0; return "Error - factorial result is greater than system limit ($input)" if $input > 170; return 1 if $input == 0; @@ -436,39 +489,77 @@ sub sub_string { } sub pow {return $_[0] ** $_[1]; } -sub ceil {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? (int($_[0])+ 1) : int($_[0])); } -sub floor {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? int($_[0]) : (int($_[0])-1)); } +sub ceil {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? (CORE::int($_[0])+ 1) : CORE::int($_[0])); } +sub floor {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? CORE::int($_[0]) : (CORE::int($_[0])-1)); } #sub floor {return int($_[0]); } sub format { my ($value,$fmt)=@_; - return sprintf('%.'.$fmt,$value); + my $dollarmode; + if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } + $fmt=~s/e/E/g; + my $result=sprintf('%.'.$fmt,$value); + $result=~s/(E[+-]*)0/$1/; + if ($dollarmode) {$result=&dollarmode($result);} + return $result; } sub prettyprint { - my ($value,$fmt)=@_; + my ($value,$fmt,$target)=@_; my $result; + my $dollarmode; + if (!$target) { $target = $external::target; } + if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } if ($fmt) { $value=sprintf('%.'.$fmt,$value); } - if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/ ) { + if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/i ) { my $frac=$1; + if ($dollarmode) { $frac=&dollarformat($frac); } my $exponent=$2; $exponent=~s/^\+0*//; - if (!$exponent) { return $frac; } - if ($external::target eq 'web') { - $result=$frac.'×10'.$exponent.''; - } elsif ($external::target eq 'tex') { - $result='\ensuremath{'.$frac.'\times 10^{'.$exponent.'}}'; + $exponent=~s/^-0*/-/; + $exponent=~s/^-0*/-/; + if ($exponent eq '-') { undef($exponent); } + if ($exponent) { + if ($target eq 'web') { + $result=$frac.'×10'.$exponent.''; + } elsif ($target eq 'tex') { + $result='\ensuremath{'.$frac.'\times 10^{'.$exponent.'}}'; + } else { + $result=$value; + } } else { - $result=$value; + $result=$frac; } } else { $result=$value; + if ($dollarmode) { $result=&dollarformat($result,$target); } } return $result; } +sub dollarformat { + my ($number,$target) = @_; + if (!$target) { $target = $external::target; } + if ($number =~ /\./) { + while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*$)/) { + $number = $1.','.$2.$3; + } + } else { + while ($number =~ /([^,]+)([^,][^,][^,])([,0-9]*)$/) { + $number = $1.','.$2.$3; + } + } + if ($target eq 'tex') { + $number='\$'.$number; #' stupid emacs + } else { + $number='$'.$number; #' stupid emacs + } + return $number; +} + sub map { my ($phrase,$dest,$source)=@_; + my @oldseed=&random_get_seed(); my @seed = &random_seed_from_phrase($phrase); &random_set_seed(@seed); my $destct = scalar(@$dest); @@ -480,6 +571,7 @@ sub map { $output[$ctr] = $$dest[$idx[$ctr]]; $ctr++; } + &random_set_seed(@oldseed); return @output; } else { my $num = scalar(@$source); @@ -499,10 +591,13 @@ sub map { } } } + &random_set_seed(@oldseed); + return ''; } sub rmap { my ($phrase,$dest,$source)=@_; + my @oldseed=&random_get_seed(); my @seed = &random_seed_from_phrase($phrase); &random_set_seed(@seed); my $destct = scalar(@$dest); @@ -520,6 +615,7 @@ sub rmap { $output[$ctr] = $$dest[$r_idx[$ctr]]; $ctr++; } + &random_set_seed(@oldseed); return @output; } else { my $num = scalar(@$source); @@ -545,6 +641,8 @@ sub rmap { } } } + &random_set_seed(@oldseed); + return ''; } sub capa_id { return } @@ -640,7 +738,7 @@ sub array_moments { $kurt+=$x**4; } $output[2]=$var/($N-1); - $sdev=sqrt($output[2]); + $sdev=CORE::sqrt($output[2]); if ($sdev == 0) { $output[3]="inf-variance=0"; $output[4]="inf-variance=0"; @@ -656,4 +754,13 @@ sub choose { return $_[$num]; } +# expiremental idea +sub proper_path { + my ($path)=@_; + if ( $external::target eq "tex" ) { + return '/home/httpd/html'.$path; + } else { + return $path; + } +}