--- loncom/homework/default_homework.lcpm 2000/10/05 19:24:23 1.2 +++ loncom/homework/default_homework.lcpm 2002/02/06 16:18:26 1.46 @@ -1,34 +1,658 @@ -# 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.46 2002/02/06 16:18:26 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 +$hidden::RANDOMINIT=0; +$pi=atan2(1,1)*4; +$rad2deg=180.0/$pi; +$deg2rad=$pi/180.0; +$"=' '; + +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 $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)=@_; + + + #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 { + 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 '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 + } else { + if ($tol =~ /%$/) { + chop $tol; + $tol_type=2; #TOL_PERCENTAGE + } else { + $tol_type=1; #TOL_ABSOLUTE + } + } + + if ($sig eq '') { + $sig_lbound = 0; #SIG_LB_DEFAULT + $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,$unit,$calc,$id_list, + $points,$external::randomseed); + + if ($result == '1') { $result='EXACT_ANS'; } + elsif ($result == '2') { $result='APPROX_ANS'; } + elsif ($result == '3') { $result='SIG_FAIL'; } + elsif ($result == '4') { $result='UNIT_FAIL'; } + elsif ($result == '5') { $result='NO_UNIT'; } + elsif ($result == '6') { $result='UNIT_OK'; } + elsif ($result == '7') { $result='INCORRECT'; } + elsif ($result == '8') { $result='UNIT_NOTNEEDED'; } + elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; } + elsif ($result =='10') { $result='SUB_RECORDED'; } + elsif ($result =='11') { $result='BAD_FORMULA'; } + 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"; +} + +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,@list) = &get_array_args($expr,'answer'); + my $aresult=''; + my $current_answer; + 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.="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 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].'\';'); + } else { + $aresult=&caparesponse_check($responselist[$i]." $unit", + $expr.';my $answer=\''.$list[$i].'\';'); + } + my ($temp)=split /:/, $aresult; + $awards.="$temp,"; + $result.=$aresult; + } + chop $awards; + return "$awards:
$result"; +} + +sub tex { + if ( $external::target eq "tex" ) { + return @_[0]; + } else { + return @_[1]; + } +} + +sub var_in_tex { + if ( $external::target eq "tex" ) { + return @_[0]; + } else { + return ""; + } +} + +sub web { + if ( $external::target eq "tex" ) { + return @_[1]; + } else { + if ( $external::target eq "web" || $external::target eq "answer") { + return @_[2]; + } else { + return @_[0]; + } + } +} + +sub html { + if ( $external::target eq "web" ) { + return shift; + } +} + +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; } +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) } +sub exp { exp(shift) } +sub int { int(shift) } +sub log { log(shift) } +sub atan2 { atan2($_[0],$_[1]) } +sub sqrt { sqrt(shift) } + sub tan { sin($_[0]) / cos($_[0]) } -sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); } -sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) ); } +#sub atan { atan2($_[0], 1); } +#sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); } +#sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) ); } -sub html { - if ( $external::target == "web" ) { - $SCRIPT_RESULT.=@_[0]; - } +sub log10 { log($_[0])/log(10); } + +sub factorial { + my $input = 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; + my $result = 1; + for (my $i=2; $i<=$input; $i++) { $result *= $i } + return $result; } +sub sgn { + return -1 if $_[0] < 0; + return 0 if $_[0] == 0; + return 1 if $_[0] > 0; +} + +sub min { + my @sorted = sort { $a <=> $b || $a cmp $b } @_; + return shift @sorted; +} + +sub max { + my @sorted = sort { $a <=> $b || $a cmp $b } @_; + return pop @sorted; +} + +sub roundto { + my ($input,$n) = @_; + return sprintf('%.'.$n.'f',$input); +} + +sub to_string { + my ($input,$n) = @_; + return sprintf($input) if $n eq ""; + $n = '.'.$n if $n !~ /^\./; + return sprintf('%'.$n,$input) if $n ne ""; +} + +sub sub_string { + my ($str,$start,$len) = @_; + return substr($str,$start-1,$len); +} 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)=@_; - $SCRIPT_RESULT.=sprintf('%.'.$fmt,$value); + return sprintf('%.'.$fmt,$value); +} + +sub prettyprint { + my ($value,$fmt)=@_; + my $result; + if ($fmt) { $value=sprintf('%.'.$fmt,$value); } + if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/ ) { + my $frac=$1; + my $exponent=$2; + $exponent=~s/^\+0*//; + 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=$value; + } + return $result; +} + +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 } + +sub problem { return } + +sub name{ + my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename'); + $fullname = "" if $fullname eq ", "; + $fullname =~ s/\%2d/-/g; + return $fullname; +} + +sub student_number { + my $id = &EXT('environment.id'); + $id = '' if $id eq ""; + return $id; +} + +sub class { + my $course = &EXT('course.description'); + $course = '' if $course eq ""; + return $course; +} + +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"; + } + return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm; +# return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3]; +} + +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"; + } + return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm; +# return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3]; +} + +sub array_moments { + my @input=@_; + my (@output,$N); + $N=scalar (@input); + $output[0]=$N; + if ($N <= 1) { + $output[1]=$input[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"; + return @output; + } + my $sum=0; + foreach my $line (@input) { + $sum+=$line; + } + $output[1] = $sum/$N; + my ($x,$sdev,$var,$skew,$kurt) = 0; + foreach my $line (@input) { + $x=$line-$output[1]; + $var+=$x**2; + $skew+=$x**3; + $kurt+=$x**4; + } + $output[2]=$var/($N-1); + $sdev=sqrt($output[2]); + if ($sdev == 0) { + $output[3]="inf-variance=0"; + $output[4]="inf-variance=0"; + return @output; + } + $output[3]=$skew/($sdev**3*$N); + $output[4]=$kurt/($sdev**4*$N)-3; + return @output; +} + +sub choose { + my $num = $_[0]; + return $_[$num]; +} + +