--- loncom/homework/default_homework.lcpm 2005/02/17 23:42:38 1.93
+++ loncom/homework/default_homework.lcpm 2005/12/20 20:00:42 1.106
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
#
-# $Id: default_homework.lcpm,v 1.93 2005/02/17 23:42:38 albertel Exp $
+# $Id: default_homework.lcpm,v 1.106 2005/12/20 20:00:42 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -89,11 +89,15 @@ sub caparesponse_check {
} else {
$message .="no ws in :$response:\n";
}
- if ($type eq 'cs' || $type eq 'ci' || $type eq 'mc') {
+ &LONCAPA_INTERNAL_DEBUG(" type is $type ");
+ if ($type eq 'cs' || $type eq 'ci') {
#for string answers make surec all places spaces occur, there is
#really only 1 space, in both the answer and the response
$answer=~s/ +/ /g;
$response=~s/ +/ /g;
+ } elsif ($type eq 'mc') {
+ $answer=~s/[\s,]//g;
+ $response=~s/[\s,]//g;
}
if ($type eq 'float' && $unit=~/\$/) {
if ($response!~/^\$/) { return "NO_UNIT: Missing \$ "; }
@@ -163,6 +167,8 @@ sub caparesponse_check {
elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; }
elsif ($result =='10') { $result='SUB_RECORDED'; }
elsif ($result =='11') { $result='BAD_FORMULA'; }
+ elsif ($result =='12' && !$response) { $result='MISSING_ANSWER'; }
+ elsif ($result =='12') { $result='WANTED_NUMERIC'; }
elsif ($result =='13') { $result='UNIT_INVALID_INSTRUCTOR'; }
elsif ($result =='141') { $result='UNIT_INVALID_STUDENT'; }
elsif ($result =='142') { $result='UNIT_INVALID_STUDENT'; }
@@ -176,23 +182,24 @@ sub caparesponse_check {
sub caparesponse_check_list {
my $response=$LONCAPA::CAPAresponse_args{'response'};
- my ($result,@list);
- @list=@LONCAPA::CAPAresponse_answer;
- my $aresult='';
- my $current_answer;
- my $answers=join(':',@list);
- $result.="Got response :$answers:\n";
- &LONCAPA_INTERNAL_DEBUG(" got ".join(':',%LONCAPA::CAPAresponse_args));
+ my $result="Got response :".join(':',@LONCAPA::CAPAresponse_answer).":\n";
+ &LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args));
my @responselist;
my $type = $LONCAPA::CAPAresponse_args{'type'};
$result.="Got type :$type:\n";
- if ($type ne '' && $#list > 0) {
- (@responselist)=split /,/,$response;
+ if ($type ne '' && $#LONCAPA::CAPAresponse_answer > 0) {
+ (@responselist)=split(/,/,$response);
+ if (@responselist < @LONCAPA::CAPAresponse_answer) {
+ return 'MISSING_ANSWER';
+ }
+ if (@responselist > @LONCAPA::CAPAresponse_answer) {
+ return 'EXTRA_ANSWER';
+ }
} else {
(@responselist)=($response);
}
- my $unit='';
$result.="Initial final response :$responselist['-1']:\n";
+ my $unit;
if ($type eq '' || $type eq 'float') {
#for numerical problems split off the unit
if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) {
@@ -201,28 +208,32 @@ sub caparesponse_check_list {
}
}
$result.="Final final response :$responselist['-1']:$unit:\n";
- $result.=":$#list: answers\n";
$unit=~s/\s//;
- my $i=0;
- my $awards='';
- my @msgs;
- for ($i=0; $i<@list;$i++) {
- my $msg;
- $result.="trying answer :$list[$i]:\n";
- my $thisanswer=$list[$i];
+
+ my ($awards, @msgs, $i);
+ foreach my $thisanswer (@LONCAPA::CAPAresponse_answer) {
+ my ($msg,$aresult);
$result.="trying answer :$thisanswer:\n";
- if ($unit eq '') {
- ($aresult,$msg)=&caparesponse_check($thisanswer,$responselist[$i]);
+ if (defined($thisanswer)) {
+ if ($unit eq '') {
+ ($aresult,$msg)=&caparesponse_check($thisanswer,
+ $responselist[$i]);
+ } else {
+ ($aresult,$msg)=&caparesponse_check($thisanswer,
+ $responselist[$i]." $unit");
+ }
} else {
- ($aresult,$msg)=&caparesponse_check($thisanswer,
- $responselist[$i]." $unit");
+ $aresult='ERROR';
+ $msg='answer was undefined';
}
- my ($temp)=split /:/, $aresult;
+ &LONCAPA_INTERNAL_DEBUG("after if $aresult -- $msg");
+ my ($temp)=split(/:/, $aresult);
$awards.="$temp,";
$result.=$aresult;
push(@msgs,$msg);
+ $i++;
}
- chop $awards;
+ chop($awards);
return ("$awards:\n$result",@msgs);
}
@@ -445,14 +456,14 @@ sub random_negative_binomial {
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 abs { CORE::abs(shift) }
+sub sin { CORE::sin(shift) }
+sub cos { CORE::cos(shift) }
+sub exp { CORE::exp(shift) }
+sub int { CORE::int(shift) }
+sub log { CORE::log(shift) }
+sub atan2 { CORE::atan2($_[0],$_[1]) }
+sub sqrt { CORE::sqrt(shift) }
sub tan { CORE::sin($_[0]) / CORE::cos($_[0]) }
#sub atan { atan2($_[0], 1); }
@@ -516,10 +527,15 @@ sub format {
#if ($options =~ /\$/) { $dollamode=1; }
#if ($options =~ /,/) { $commamode=1; }
if ($options =~ /\./) { $alwaysperiod=1; }
- $fmt=~s/e/E/g;
- my $result=sprintf('%.'.$fmt,$value);
- if ($alwaysperiod && $fmt eq '0f') { $result .='.'; }
- $result=~s/(E[+-]*)0/$1/;
+ my $result;
+ if ($fmt=~/s$/i) {
+ $result=&format_significant_figures($value,$fmt);
+ } else {
+ $fmt=~s/e/E/g;
+ $result=sprintf('%.'.$fmt,$value);
+ if ($alwaysperiod && $fmt eq '0f') { $result .='.'; }
+ $result=~s/(E[+-]*)0/$1/;
+ }
#if ($dollarmode) {$result=&dollarformat($result);}
#if ($commamode) {$result=&commaformat($result);}
return $result;
@@ -527,24 +543,33 @@ sub format {
sub chemparse {
my ($reaction) = @_;
- my @tokens = split(/(\s\+|\->|<=>)/,$reaction);
+ my @tokens = split(/(\s\+|\->|<=>|<\-|\.)/,$reaction);
my $formula = '';
foreach my $token (@tokens) {
if ($token eq '->' ) {
$formula .= '\ensuremath{\rightarrow} ';
next;
}
+ if ($token eq '<-' ) {
+ $formula .= '\ensuremath{\leftarrow} ';
+ next;
+ }
if ($token eq '<=>') {
if ($external::target eq 'web' &&
&EXT('request.browser.unicode')) {
$formula .= '⇌ ';
} else {
$formula .= &web('<=> ','\ensuremath{\rightleftharpoons} ',
- '<=$gt; ');
+ '<=> ');
}
next;
}
- $token =~ /^\s*(\d*(?:&frac\d\d)?)(.*)/;
+ if ($token eq '.') {
+ $formula =~ s/(\ \;| )$//;
+ $formula .= '·';
+ next;
+ }
+ $token =~ /^\s*([\d|\/]*(?:&frac\d\d)?)(.*)/;
$formula .= $1 if ($1 ne '1'); # stoichiometric coefficient
my $molecule = $2;
@@ -556,6 +581,7 @@ sub chemparse {
$molecule =~ s/\s*//g;
# forced space
$molecule =~ s/_/ /g;
+ $molecule =~ s/-/−/g;
$formula .= $molecule.' ';
}
# get rid of trailing space
@@ -573,7 +599,11 @@ sub prettyprint {
if ($options =~ /\$/) { $dollarmode=1; }
if ($options =~ /,/) { $commamode=1; }
if ($options =~ /\./) { $alwaysperiod=1; }
- if ($fmt) { $value=sprintf('%.'.$fmt,$value); }
+ if ($fmt=~/s$/i) {
+ $value=&format_significant_figures($value,$fmt);
+ } elsif ($fmt) {
+ $value=sprintf('%.'.$fmt,$value);
+ }
if ($alwaysperiod && $fmt eq '0f') {
if ($target eq 'tex') {
$value .='\\ensuremath{.}';
@@ -612,12 +642,12 @@ sub prettyprint {
sub commaformat {
my ($number,$target) = @_;
if ($number =~ /\./) {
- while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) {
- $number = $1.','.$2.$3;
+ while ($number =~ /([^0-9]*)([0-9]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) {
+ $number = $1.$2.','.$3.$4;
}
} else {
- while ($number =~ /([^,]+)([^,][^,][^,])([,0-9]*)$/) {
- $number = $1.','.$2.$3;
+ while ($number =~ /^([^0-9]*)([0-9]+)([^,][^,][^,])([,0-9]*)$/) {
+ $number = $1.$2.','.$3.$4;
}
}
return $number;
@@ -635,6 +665,41 @@ sub dollarformat {
return $number;
}
+# format of form ns or nS where n is an integer
+sub format_significant_figures {
+ my ($number,$format) = @_;
+ return '0' if ($number == 0);
+ # extract number of significant figures needed
+ my ($sig) = ($format =~ /(\d+)s/i);
+ # arbitrary choice - suggestions ?? or throw error message?
+ $sig = 3 if ($sig eq '');
+ # save the minus sign
+ my $sign = ($number < 0) ? '-' : '';
+ $number = abs($number);
+ # needed to correct for a number greater than 1 (or
+ my $power = ($number < 1) ? 0 : 1;
+ # could round up. Take the integer part of log10.
+ my $x10 = int(log($number)/log(10));
+ # find number with values left of decimal pt = # of sign figs.
+ my $xsig = $number*10**($sig-$x10-$power);
+ # get just digits left of decimal pt - also rounds off correctly
+ my $xint = sprintf('%.0f',$xsig);
+ # save any trailing zero's
+ my ($zeros) = ($xint =~ /(0+)$/);
+ # return number to original magnitude
+ my $numSig = $xint*10**($x10-$sig+$power);
+ # insert trailing zero's if have decimal point
+ $numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/;
+ # put a decimal pt for number ending with 0 and length = # of sig fig
+ $numSig.='.' if (length($numSig) == $sig && $numSig =~ /0$/);
+ if (length($numSig) < $sig) {
+ $numSig.='.'.substr($zeros,0,($sig-length($numSig)));
+ }
+ # return number with sign
+ return $sign.$numSig;
+
+}
+
sub map {
my ($phrase,$dest,$source)=@_;
my @oldseed=&random_get_seed();
@@ -830,6 +895,30 @@ sub choose {
return $_[$num];
}
+#&sum1(1,$x,sub { &sum1($_[0],2*$_[0], sub { fact($_[0])**2 })});
+#sub sum1 {
+# my ($start,$end,$sub)=@_;
+# my $sum=0;
+# for (my $i=$start;$i<=$end;$i++) {
+# $sum+=&$sub($i);
+# }
+# return $sum
+#}
+
+#&sum2('a',1,$x,'&sum2(\'b\',$a,2*$a, \'&factorial($b)**2\')');
+#sub sum2 {
+# my ($varname,$start,$end,$line)=@_;
+# my $sum=0;
+# for (my $i=$start;$i<=$end;$i++) {
+# my $func=sub {
+# eval("\$".$varname."=$i");
+# eval($line);
+# };
+# $sum+=&$func($i);
+# }
+# return $sum
+#}
+
# expiremental idea
sub proper_path {
my ($path)=@_;