--- loncom/homework/default_homework.lcpm 2001/05/31 20:47:50 1.24 +++ loncom/homework/default_homework.lcpm 2001/08/22 22:21:46 1.35 @@ -1,14 +1,12 @@ -# file name (temp): default_homework +# file name (temp): default_homework # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run() -# -# -#init some globals # # Guy Albertelli # # 05/25/2001 H. K. Ng # 05/31/2001 H. K. Ng # +#init some globals $RANDOMINIT=0; $pi=atan2(1,1)*4; $rad2deg=180.0/$pi; @@ -23,14 +21,25 @@ sub caparesponse_check { my $sig_lbound=''; #done my $sig_ubound=''; #done my $ans_fmt=''; - my $units=''; #done + my $unit=''; #done my $calc=''; my ($response,$expr)=@_; - + + ($answer,$type,$tol,$sig,$ans_fmt, - $units,$calc) = eval $expr.';return $answer,$type,$tol,$sig,$ans_fmt,$units,$calc'; + $unit,$calc) = eval $expr.';return ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc);'; #type's definitons come from capaParser.h + my $message=''; + #remove leading and trailing whitespace + if ($response=~ /^\s|\s$/) { + $response=~ s:^\s+|\s+$::g; + $message .="Removed ws now :$response:
"; + } else { + $message .="no ws in :$response:
"; + } + if ($type eq '' ) { + $message .= "Didn't find a type :$type:$expr: defaulting
"; if ( $answer eq ($answer *1.0)) { $type = 2; } else { $type = 3; } } else { @@ -63,7 +72,7 @@ sub caparesponse_check { my $result = &caparesponse_capa_check_answer($response,$answer,$type, $tol_type,$tol, $sig_lbound,$sig_ubound, - $ans_fmt,$units,$calc); + $ans_fmt,$unit,$calc); if ($result == '1') { $result='EXACT_ANS'; } elsif ($result == '2') { $result='APPROX_ANS'; } @@ -79,34 +88,54 @@ sub caparesponse_check { elsif ($result =='12') { $result='WANTED_NUMERIC'; } else {$result = "ERROR: Unknown Result:$result:$@:";} - return "$result:
Error $error:
Answer $answer:
Response $response:
$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$units
"; + return "$result:
Error $error:
Answer $answer:
Response $response:
type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$units
$message$expr"; } sub caparesponse_check_list { my ($response,$expr)=@_; + # 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 $answer'; + my (@list) = eval $CAPARESPONSE_CHECK_LIST_answer; my $result=''; + $result.="error:$@:
"; + # if the eval fails just use what is in the answer exactly + if (!defined(@list) || !defined($list[0])) { + $result.="list zero is undefined
"; + $list[0]=$CAPARESPONSE_CHECK_LIST_answer; + } my $aresult=''; my $current_answer; - my $answer = eval $expr.';return $answer'; - my (@list) = eval $answer; - my (@responselist)=split /,/,$response; + $result.="Got response :$CAPARESPONSE_CHECK_LIST_answer:$list[0]:
"; + my @responselist; + my $type =eval $expr.';return $answer;'; + if ($type ne '' && $#list > 0) { + (@responselist)=split /,/,$response; + } else { + (@responselist)=($response); + } my $unit=''; - $result.="Final response :$responselist['-1']:
"; - if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) { - $responselist['-1']=$1; - $unit=$2; + $result.="Initial final response :$responselist['-1']:
"; + if ($type eq '') { + #for numerical problems split off the unit + if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) { + $responselist['-1']=$1; + $unit=$2; + } } - $result.="Final response :$responselist['-1']:
"; + $result.="Final final response :$responselist['-1']:
"; + $result.=":$#list: answers
"; $unit=~s/\s//; my $i=0; my $awards=''; for ($i=0; $i<@list;$i++) { + $result.="trying answer :$list[$i]:
"; if ($unit eq '') { $aresult=&caparesponse_check($responselist[$i], - $expr.';my $answer='.$list[$i].';'); + $expr.';my $answer=\''.$list[$i].'\';'); } else { $aresult=&caparesponse_check($responselist[$i]." $unit", - $expr.';my $answer='.$list[$i].';'); + $expr.';my $answer=\''.$list[$i].'\';'); } my ($temp)=split /:/, $aresult; $awards.="$temp,"; @@ -137,16 +166,16 @@ sub web { return @_[1]; } else { if ( $external::target eq "web") { - return @_[0]; - } else { return @_[2]; + } else { + return @_[0]; } } } sub html { if ( $external::target eq "web" ) { - return @_[0]; + return shift; } } @@ -166,6 +195,133 @@ sub random { return $result; } +sub random_normal { + my ($item_cnt,$seed,$av,$std_dev) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_normal($item_cnt,$av,$std_dev); + return @retArray; +} + +sub random_beta { + my ($item_cnt,$seed,$aa,$bb) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_beta($item_cnt,$aa,$bb); + return @retArray; +} + +sub random_gamma { + my ($item_cnt,$seed,$a,$r) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_gamma($item_cnt,$a,$r); + return @retArray; +} + +sub random_exponential { + my ($item_cnt,$seed,$av) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_exponential($item_cnt,$av); + return @retArray; +} + +sub random_poisson { + my ($item_cnt,$seed,$mu) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_poisson($item_cnt,$mu); + return @retArray; +} + +sub random_chi { + my ($item_cnt,$seed,$df) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_chi_square($item_cnt,$df); + return @retArray; +} + +sub random_noncentral_chi { + my ($item_cnt,$seed,$df,$nonc) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc); + return @retArray; +} + +sub random_f { + my ($item_cnt,$seed,$dfn,$dfd) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_f($item_cnt,$dfn,$dfd); + return @retArray; +} + +sub random_noncentral_f { + my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc); + return @retArray; +} + +sub random_multivariate_normal { + my ($item_cnt,$seed,$mean,$covar) = @_; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar); + return @retArray; +} + +sub random_multinomial { + my ($item_cnt,$seed,@p) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_multinomial($item_cnt,@p); + return @retArray; +} + +sub random_permutation { + my ($seed,@inArray) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_permutation(@inArray); + return @retArray; +} + +sub random_uniform { + my ($item_cnt,$seed,$low,$high) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_uniform($item_cnt,$low,$high); + return @retArray; +} + +sub random_uniform_integer { + my ($item_cnt,$seed,$low,$high) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_uniform_integer($item_cnt,$low,$high); + return @retArray; +} + +sub random_binomial { + my ($item_cnt,$seed,$nt,$p) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_binomial($item_cnt,$nt,$p); + return @retArray; +} + +sub random_negative_binomial { + my ($item_cnt,$seed,$ne,$p) = @_; + my @retArray; + &random_set_seed_from_phrase($seed); + @retArray=&math_random_negative_binomial($item_cnt,$ne,$p); + return @retArray; +} + sub abs { abs(shift) } sub sin { sin(shift) } sub cos { cos(shift) } @@ -215,8 +371,9 @@ sub roundto { sub to_string { my ($input,$n) = @_; - return sprintf('%'.$n,$input) if $n ne ""; return sprintf($input) if $n eq ""; + $n = '.'.$n if $n !~ /^\./; + return sprintf('%'.$n,$input) if $n ne ""; } sub sub_string { @@ -225,8 +382,9 @@ sub sub_string { } sub pow {return $_[0] ** $_[1]; } -sub ceil {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (int($_[0])+ 1); } -sub floor {return int($_[0]); } +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 floor {return int($_[0]); } sub format { my ($value,$fmt)=@_; @@ -234,21 +392,83 @@ sub format { } sub map { - my $num = $#_/2; - my $i; - my @used; - my @permutation; - for ($i=0; $i < $num;) { - $rand = &random(1,$num,1); - if ( $used[$rand] == '0' ) { - $i++; - $used[$rand]='1'; - $permutation[$i]=$rand; + my ($phrase,$dest,$source)=@_; + my @seed = &random_seed_from_phrase($phrase); + &random_set_seed(@seed); + my $destct = scalar(@$dest); + if (!$source) { + my @output; + my @idx = &math_random_permuted_index($destct); + my $ctr = 0; + while ($ctr < $destct) { + $output[$ctr] = $$dest[$idx[$ctr]]; + $ctr++; + } + return @output; + } else { + my $num = scalar(@$source); + my @idx = &math_random_permuted_index($num); + my $ctr = 0; + my $tot = $num; + $tot = $destct if $destct < $num; + if (ref($$dest[0])) { + while ($ctr < $tot) { + ${$$dest[$ctr]} = $$source[$idx[$ctr]]; + $ctr++; + } + } else { + while ($ctr < $tot) { + $$dest[$ctr] = $$source[$idx[$ctr]]; + $ctr++; + } + } + } +} + +sub rmap { + my ($phrase,$dest,$source)=@_; + my @seed = &random_seed_from_phrase($phrase); + &random_set_seed(@seed); + my $destct = scalar(@$dest); + if (!$source) { + my @idx = &math_random_permuted_index($destct); + my $ctr = 0; + my @r_idx; + while ($ctr < $destct) { + $r_idx[$idx[$ctr]] = $ctr; + $ctr++; + } + my @output; + $ctr = 0; + while ($ctr < $destct) { + $output[$ctr] = $$dest[$r_idx[$ctr]]; + $ctr++; + } + return @output; + } else { + my $num = scalar(@$source); + my @idx = &math_random_permuted_index($num); + my $ctr = 0; + my $tot = $num; + $tot = $destct if $destct < $num; + my @r_idx; + while ($ctr < $tot) { + $r_idx[$idx[$ctr]] = $ctr; + $ctr++; + } + $ctr = 0; + if (ref($$dest[0])) { + while ($ctr < $tot) { + ${$$dest[$ctr]} = $$source[$r_idx[$ctr]]; + $ctr++; + } + } else { + while ($ctr < $tot) { + $$dest[$ctr] = $$source[$r_idx[$ctr]]; + $ctr++; + } + } } - } - for ( $i=1 ; $i<$num+1 ; $i++ ) { - ${$_[$permutation[$i]]}=$_[$i+$num] - } } sub capa_id { return } @@ -258,7 +478,7 @@ sub problem { return } sub name{ my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename'); $fullname = "" if $fullname eq ", "; - $fullname =~ s/\%2d/-/; + $fullname =~ s/\%2d/-/g; return $fullname; } @@ -325,7 +545,7 @@ sub array_moments { $output[0]=$N; if ($N <= 1) { $output[1]=$input[0]; - $output[1] = "Input array not defined" if ($N == 0); + $output[1]="Input array not defined" if ($N == 0); $output[2]="variance undefined for N<=1"; $output[3]="skewness undefined for N<=1"; $output[4]="kurtosis undefined for N<=1"; @@ -360,11 +580,4 @@ sub choose { return $_[$num]; } -#$external::randomseed=time; -#$a=2; -#$b=2; -#$c=2; -#&map(1,\$a,\$b,\$c,3,4,5); -#print $a."\n".$b."\n"; -