--- loncom/homework/default_homework.lcpm 2001/01/16 20:15:40 1.15
+++ loncom/homework/default_homework.lcpm 2001/07/19 21:26:22 1.31
@@ -1,26 +1,36 @@
-# file name (temp): default_homework
+# file name (temp): default_homework
# used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
-#
#
+# 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;
+$deg2rad=$pi/180.0;
sub caparesponse_check {
my $answer=''; #done
my $type=''; #done
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 $sig=''; #done lowerbnd,upperbnd
+ my $sig_lbound=''; #done
+ my $sig_ubound=''; #done
my $ans_fmt='';
- my $units='';
+ 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='';
if ($type eq '' ) {
+ $message .= "Didn't find a type :$type:$expr: defaulting
";
if ( $answer eq ($answer *1.0)) { $type = 2;
} else { $type = 3; }
} else {
@@ -53,7 +63,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'; }
@@ -69,36 +79,60 @@ 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;
+ 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;
}
chop $awards;
- return "$awards:
$result";
+ return "$awards:
$result";
}
sub tex {
@@ -109,18 +143,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 {
return @_[2];
+ } else {
+ return @_[0];
}
}
}
+sub html {
+ if ( $external::target eq "web" ) {
+ return shift;
+ }
+}
+
sub problem {
return '1';
}
@@ -137,20 +185,203 @@ 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) = @_;
+ 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++;
+ }
+ &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 eq "web" ) {
- return @_[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)=@_;
@@ -158,30 +389,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";
+ }
+ 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;
}
- for ( $i=1 ; $i<$num+1 ; $i++ ) {
- ${$_[$permutation[$i]]}=$_[$i+$num]
+ 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";
+
+