[$j] =~ /[\000-\037]/) {
+ $response->[$j] =~ s/[\000-\037]//g;
+ $control_chars_removed = 1;
+ }
+ }
+ }
+ my ($award,$msg) = &caparesponse_check($answer->[$j],
+ $response->[$j]);
+ if ($type eq 'cs' || $type eq 'ci') {
+ $error = &verify_stringresponse($type,$award,$response->[$j],
+ $answer->[$j]);
+ }
+ push(@awards,$award);
+ push(@msgs, $msg);
+ }
+ ($award,$msg) =
+ &LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs);
+ }
+ $memoized{$key} = [$award,$msg];
+ }
+ }
+ }
+
+ my ($final_award,$final_msg);
+ &init_permutation(scalar(@$responses),
+ $LONCAPA::CAPAresponse_answer->{'type'});
+
+ # possible FIXMEs
+ # - significant time is spent calling non-safe space routine
+ # from safe space
+ # - early outs could be possible with classifying awards is to stratas
+ # and stopping as so as hitting the top strata
+ # - some early outs also might be possible with check ing the
+ # memoized hash of results (is correct even possible? etc.)
+
+ my (@final_awards,@final_msg);
+ while( &get_permutations_left() ) {
+ my $order = &get_next_permutation();
+ my (@awards, @msgs, $i);
+ foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) {
+ my $key = "$thisanswer\0".$responses->[$order->[$i]];
+ push(@awards,$memoized{$key}[0]);
+ push(@msgs,$memoized{$key}[1]);
+ $i++;
+
}
- my ($temp)=split /:/, $aresult;
- $awards.="$temp,";
- $result.=$aresult;
- push(@msgs,$msg);
+ &LONCAPA_INTERNAL_DEBUG(" all awards ".join(':',@awards));
+
+ my ($possible_award,$possible_msg) =
+ &LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs);
+ &LONCAPA_INTERNAL_DEBUG(" pos awards ".$possible_award);
+ push(@final_awards,$possible_award);
+ push(@final_msg,$possible_msg);
+ }
+
+ &LONCAPA_INTERNAL_DEBUG(" all final_awards ".join(':',@final_awards));
+ my ($final_award,$final_msg) =
+ &LONCAPA_INTERNAL_FINALIZEAWARDS(\@final_awards,\@final_msg,undef,1);
+ return ($final_award,$final_msg,$error,$control_chars_removed,$ansstring);
+}
+
+sub verify_stringresponse {
+ my ($type,$award,$resp,$ans) = @_;
+ return if ($award eq 'EXACT_ANS');
+ my $error;
+ if ($resp =~ /^\s|\s$/) {
+ $resp =~ s{^\s+|\s+$}{}g;
+ }
+ if ($ans =~ /^\s|\s$/) {
+ $ans =~ s{^\s+|\s+$}{}g;
+ }
+ if ($type eq 'ci') {
+ $resp = lc($resp);
+ $ans = lc($ans);
+ }
+ if ($resp eq $ans) {
+ if ($award eq 'INCORRECT') {
+ $error = 'MISGRADED';
+ }
+ }
+ return $error;
+}
+
+sub cas {
+ my ($system,$input,$library)=@_;
+ my $output;
+ my $dump;
+ if ($system eq 'maxima') {
+ $output=&maxima_eval($input,$library);
+ } elsif ($system eq 'R') {
+ ($output,$dump)=&r_eval($input,$library,0);
+ } else {
+ $output='Error: unrecognized CAS';
}
- chop $awards;
- return ("$awards:\n$result",@msgs);
+ return $output;
+}
+
+sub cas_hashref {
+ my ($system,$input,$library)=@_;
+ if ($system eq 'maxima') {
+ return 'Error: unsupported CAS';
+ } elsif ($system eq 'R') {
+ return &r_eval($input,$library,1);
+ } else {
+ return 'Error: unrecognized CAS';
+ }
+}
+
+#
+# cas_hashref_entry takes a list of indices and gets the entry in a hash generated by Rreturn.
+# Call: cas_hashref_entry(Rvalue, index1, index2, ...) where Rvalue is a hash returned by Rreturn.
+# Rentry will return the first scalar value it encounters (ignoring excess indices).
+# If an invalid key is given, it returns undef.
+#
+sub cas_hashref_entry {
+ return &Rentry(@_);
+}
+
+#
+# cas_hashref_array takes a list of indices and gets a column array from a hash generated by Rreturn.
+# Call: cas_hashref_array(Rvalue, index1, index2, ...) where Rvalue is a hash returned by Rreturn.
+# If an invalid key is given, it returns undef.
+#
+sub cas_hashref_array {
+ return &Rarray(@_);
}
sub tex {
@@ -447,14 +770,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); }
@@ -518,10 +841,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;
@@ -529,13 +857,17 @@ 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')) {
@@ -546,7 +878,12 @@ sub chemparse {
}
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;
@@ -558,6 +895,7 @@ sub chemparse {
$molecule =~ s/\s*//g;
# forced space
$molecule =~ s/_/ /g;
+ $molecule =~ s/-/−/g;
$formula .= $molecule.' ';
}
# get rid of trailing space
@@ -575,7 +913,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{.}';
@@ -614,12 +956,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;
@@ -637,6 +979,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();
@@ -748,46 +1125,100 @@ sub class {
return $course;
}
+sub classid {
+ my $courseid = &EXT('request.course.id');
+ $courseid = '' if $courseid eq "";
+ return $courseid;
+}
+
+sub firstname {
+ my $firstname = &EXT('environment.firstname');
+ $firstname = '' if $firstname eq "";
+ return $firstname;
+}
+
+sub middlename {
+ my $middlename = &EXT('environment.middlename');
+ $middlename = '' if $middlename eq "";
+ return $middlename;
+}
+
+
+sub lastname {
+ my $lastname = &EXT('environment.lastname');
+ $lastname = '' if $lastname eq "";
+ return $lastname;
+}
+
sub sec {
my $sec = &EXT('request.course.sec');
$sec = '' if $sec eq "";
return $sec;
}
+sub submission {
+ my ($partid,$responseid,$subnumber)=@_;
+ my $sub='';
+ if ($subnumber) { $sub=$subnumber.':'; }
+ return &EXT('user.resource.'.$sub.'resource.'.$partid.'.'.$responseid.'.submission');
+}
+
+sub currentpart {
+ return $external::part;
+}
+
+sub eval_time {
+ my ($timestamp)=@_;
+ unless ($timestamp) { return ''; }
+ return &locallocaltime($timestamp);
+}
+
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;
+ my ($partid)=@_;
+ unless ($partid) { $partid=0; }
+ return &eval_time(&EXT('resource.'.$partid.'.opendate'));
+}
+
+sub due_date {
+ my ($partid)=@_;
+ unless ($partid) { $partid=0; }
+ return &eval_time(&EXT('resource.'.$partid.'.duedate'));
}
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;
+ my ($partid)=@_;
+ unless ($partid) { $partid=0; }
+ return &eval_time(&EXT('resource.'.$partid.'.answerdate'));
+}
+
+sub open_date_epoch {
+ my ($partid)=@_;
+ unless ($partid) { $partid=0; }
+ return &EXT('resource.'.$partid.'.opendate');
+}
+
+sub due_date_epoch {
+ my ($partid)=@_;
+ unless ($partid) { $partid=0; }
+ return &EXT('resource.'.$partid.'.duedate');
+}
+
+sub answer_date_epoch {
+ my ($partid)=@_;
+ unless ($partid) { $partid=0; }
+ return &EXT('resource.'.$partid.'.answerdate');
+}
+
+sub parameter_setting {
+ my ($which,$partid)=@_;
+ unless ($partid) { $partid=0; }
+ return &EXT('resource.'.$partid.'.'.$which);
+}
+
+sub stored_data {
+ my ($which,$partid)=@_;
+ unless ($partid) { $partid=0; }
+ return &EXT('user.resource.resource.'.$partid.'.'.$which);
}
sub array_moments {
@@ -832,6 +1263,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)=@_;
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.