--- loncom/homework/default_homework.lcpm 2001/02/20 23:46:25 1.18
+++ loncom/homework/default_homework.lcpm 2001/12/21 21:37:26 1.44
@@ -1,28 +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.44 2001/12/21 21:37:26 matthew 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='';
- my $sig_lbound='';
- my $sig_ubound='';
- my $ans_fmt='';
- my $units='';
- my $calc='';
+ my $sig_lbound=''; #done
+ my $sig_ubound=''; #done
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 {
@@ -31,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
@@ -55,7 +105,8 @@ 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,$id_list,
+ $points,$external::randomseed);
if ($result == '1') { $result='EXACT_ANS'; }
elsif ($result == '2') { $result='APPROX_ANS'; }
@@ -71,30 +122,66 @@ 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++) {
- $aresult=&caparesponse_check($responselist[$i]." $unit",
- $expr.';my $answer='.$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;
@@ -111,18 +198,32 @@ sub tex {
}
}
+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") {
- return @_[0];
- } 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';
}
@@ -133,28 +234,205 @@ sub hinton {
sub random {
my ($start,$end,$step)=@_;
- if ( ! $RANDOMINIT ) { srand($external::randomseed); $RANDOMINIT=1; }
+ if ( ! $hidden::RANDOMINIT ) {
+ srand($external::randomseed);
+ $hidden::RANDOMINIT=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 atan { atan2($_[0], 1); }
-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 log10 { log($_[0])/log(10); }
-sub html {
- if ( $external::target eq "web" ) {
- return @_[0];
- }
+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)=@_;
@@ -162,30 +440,192 @@ 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++;
+ }
+ }
+ }
+}
+
+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";
}
- for ( $i=1 ; $i<$num+1 ; $i++ ) {
- ${$_[$permutation[$i]]}=$_[$i+$num]
+ 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];
}
-#$external::randomseed=time;
-#$a=2;
-#$b=2;
-#$c=2;
-#&map(1,\$a,\$b,\$c,3,4,5);
-#print $a."\n".$b."\n";
+
+