--- loncom/homework/default_homework.lcpm 2001/06/12 21:07:32 1.26 +++ loncom/homework/default_homework.lcpm 2002/07/17 18:08:39 1.48 @@ -1,34 +1,69 @@ -# file name (temp): default_homework +# The LearningOnline Network with CAPA # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run() # +# $Id: default_homework.lcpm,v 1.48 2002/07/17 18:08:39 albertel Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# +# # Guy Albertelli # # 05/25/2001 H. K. Ng # 05/31/2001 H. K. Ng +# 12/21/2001 Matthew # #init some globals -$RANDOMINIT=0; +$hidden::RANDOMINIT=0; $pi=atan2(1,1)*4; $rad2deg=180.0/$pi; $deg2rad=$pi/180.0; +$"=' '; sub caparesponse_check { - my $answer=''; #done - my $type=''; #done + #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 $tol_type=''; # gets it's value from whether tol has a % or not done - my $tol=''; #done - my $sig=''; #done lowerbnd,upperbnd my $sig_lbound=''; #done my $sig_ubound=''; #done - my $ans_fmt=''; - my $units=''; #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'; + + #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 { @@ -37,9 +72,18 @@ sub caparesponse_check { } elsif ($type eq 'mc') { $type = 5; } elsif ($type eq 'fml') { $type = 8; } 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" } } + my $points; + my $id_list; + #formula type setup the sample points + if ($type eq '8') { + ($id_list,$points)=split(/@/,$samples); + $message.="Found :$points: points
"; + } if ($tol eq '') { $tol=0.0; $tol_type=1; #TOL_ABSOLUTE @@ -57,11 +101,17 @@ sub caparesponse_check { $sig_ubound =15; #SIG_UB_DEFAULT } else { ($sig_lbound,$sig_ubound) = split /,/,$sig; + if (!$sig_lbound) { + $sig_lbound = 0; #SIG_LB_DEFAULT + $sig_ubound =15; #SIG_UB_DEFAULT + } + if (!$sig_ubound) { $sig_ubound=$sig_lbound; } } my $result = &caparesponse_capa_check_answer($response,$answer,$type, $tol_type,$tol, $sig_lbound,$sig_ubound, - $ans_fmt,$units,$calc); + $ans_fmt,$unit,$calc,$id_list, + $points,$external::randomseed); if ($result == '1') { $result='EXACT_ANS'; } elsif ($result == '2') { $result='APPROX_ANS'; } @@ -77,34 +127,65 @@ 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|$unit|
$message$expr"; +} + +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 @GET_ARRAY_ARGS_list; + if ($CAPARESPONSE_CHECK_LIST_answer =~ /^\s*[\$\@]/) { + (@GET_ARRAY_ARGS_list) = eval $CAPARESPONSE_CHECK_LIST_answer; + } + $GET_ARRAY_ARGS_result.="error:$@:
"; + # 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
"; + $GET_ARRAY_ARGS_list[0]=$CAPARESPONSE_CHECK_LIST_answer; + } + return $GET_ARRAY_ARGS_result,@GET_ARRAY_ARGS_list; } sub caparesponse_check_list { my ($response,$expr)=@_; - my $result=''; + my $result; + my ($result,@list) = &get_array_args($expr,'answer'); my $aresult=''; my $current_answer; - my $answer = eval $expr.';return $answer'; - my (@list) = eval $answer; - my (@responselist)=split /,/,$response; + my $answers=join(':',@list); + $result.="Got response :$answers:
"; + 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,"; @@ -134,7 +215,7 @@ sub web { if ( $external::target eq "tex" ) { return @_[1]; } else { - if ( $external::target eq "web") { + if ( $external::target eq "web" || $external::target eq "answer") { return @_[2]; } else { return @_[0]; @@ -158,7 +239,11 @@ sub hinton { sub random { my ($start,$end,$step)=@_; - if ( ! $RANDOMINIT ) { srand($external::randomseed); $RANDOMINIT=1; } + 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; @@ -237,16 +322,9 @@ sub random_noncentral_f { } sub random_multivariate_normal { - my ($item_cnt,$seed,@mean) = @_; - return "Number of deviates must be greater than 0" if $item_cnt <= 0; - my (@covar,@retArray); - my $ind = 0; - while ($ind<$item_cnt) { - push @covar, pop (@mean); - $ind++; - } + my ($item_cnt,$seed,$mean,$covar) = @_; &random_set_seed_from_phrase($seed); - @retArray=&math_random_multivariate_normal($item_cnt,@mean,@covar); + @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar); return @retArray; } @@ -358,30 +436,145 @@ 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)=@_; - return sprintf('%.'.$fmt,$value); + my $dollarmode; + if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } + my $result=sprintf('%.'.$fmt,$value); + if ($dollarmode) {$result=&dollarmode($result);} + return $result; } -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; +sub prettyprint { + my ($value,$fmt)=@_; + my $result; + my $dollarmode; + if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } + if ($fmt) { $value=sprintf('%.'.$fmt,$value); } + if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/ ) { + my $frac=$1; + if ($dollarmode) { $frac=&dollarformat($frac); } + my $exponent=$2; + $exponent=~s/^\+0*//; + if ($exponent) { + if ($external::target eq 'web') { + $result=$frac.'×10'.$exponent.''; + } elsif ($external::target eq 'tex') { + $result='\ensuremath{'.$frac.'\times 10^{'.$exponent.'}}'; + } else { + $result=$value; + } + } else { + $result=$frac; } + } else { + $result=$value; + if ($dollarmode) { $result=&dollarformat($result); } } - for ( $i=1 ; $i<$num+1 ; $i++ ) { - ${$_[$permutation[$i]]}=$_[$i+$num] + return $result; +} + +sub dollarformat { + my ($number) = @_; + if ($number =~ /\./) { + while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*$)/) { + $number = $1.','.$2.$3; + } + } else { + while ($number =~ /([^,]+)([^,][^,][^,])([,0-9]*)$/) { + $number = $1.','.$2.$3; + } } + if ($external::target eq 'tex') { + $number='\$'.$number; #' stupid emacs + } else { + $number='$'.$number; #' stupid emacs + } + return $number; +} + +sub map { + 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++; + } + } + } } sub capa_id { return } @@ -458,7 +651,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";