[LON-CAPA-cvs] cvs: loncom /homework default_homework.lcpm inputtags.pm structuretags.pm /homework/caparesponse caparesponse.pm test.pl
albertel
lon-capa-cvs@mail.lon-capa.org
Fri, 29 Sep 2006 20:55:36 -0000
This is a MIME encoded message
--albertel1159563336
Content-Type: text/plain
albertel Fri Sep 29 16:55:36 2006 EDT
Modified files:
/loncom/homework default_homework.lcpm inputtags.pm
structuretags.pm
/loncom/homework/caparesponse caparesponse.pm test.pl
Log:
- BUG#33
- multiple correct answer can be defined
- when there are multiple values defined, you can set it to accept them in any order
--albertel1159563336
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20060929165536.txt"
Index: loncom/homework/default_homework.lcpm
diff -u loncom/homework/default_homework.lcpm:1.115 loncom/homework/default_homework.lcpm:1.116
--- loncom/homework/default_homework.lcpm:1.115 Fri Jul 28 11:22:28 2006
+++ loncom/homework/default_homework.lcpm Fri Sep 29 16:55:33 2006
@@ -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.115 2006/07/28 15:22:28 www Exp $
+# $Id: default_homework.lcpm,v 1.116 2006/09/29 20:55:33 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,6 +33,72 @@
$rad2deg=180.0/$pi;
$deg2rad=$pi/180.0;
$"=' ';
+use strict;
+{
+ my $n = 0;
+ my $total = 0;
+ my $num_left = 0;
+ my @order;
+ my $type;
+
+ sub init_permutation {
+ my ($size,$requested_type) = @_;
+ @order = (0..$size-1);
+ $n = $size;
+ $type = $requested_type;
+ if ($type eq 'ordered') {
+ $total = $num_left = 1;
+ } elsif ($type eq 'unordered') {
+ $total = $num_left = &factorial($size);
+ } else {
+ die("Unkown type: $type");
+ }
+ }
+
+ sub get_next_permutation {
+ if ($num_left == $total) {
+ $num_left--;
+ return @order;
+ }
+
+ # Find largest index j with a[j] < a[j+1]
+
+ my $j = scalar(@order) - 2;
+ while ($order[$j] > $order[$j+1]) {
+ $j--;
+ }
+
+ # Find index k such that a[k] is smallest integer
+ # greater than a[j] to the right of a[j]
+
+ my $k = scalar(@order) - 1;
+ while ($order[$j] > $order[$k]) {
+ $k--;
+ }
+
+ # Interchange a[j] and a[k]
+
+ @order[($k,$j)] = @order[($j,$k)];
+
+ # Put tail end of permutation after jth position in increasing order
+
+ my $r = scalar(@order) - 1;
+ my $s = $j + 1;
+
+ while ($r > $s) {
+ @order[($s,$r)]=@order[($r,$s)];
+ $r--;
+ $s++;
+ }
+
+ $num_left--;
+ return(@order);
+ }
+
+ sub get_permutations_left {
+ return $num_left;
+ }
+}
sub check_commas {
my ($response)=@_;
@@ -78,17 +144,16 @@
#type's definitons come from capaParser.h
- my $message='';
+
#remove leading and trailing whitespace
if (!defined($response)) {
$response='';
}
if ($response=~ /^\s|\s$/) {
$response=~ s:^\s+|\s+$::g;
- $message .="Removed ws now :$response:\n";
- } else {
- $message .="no ws in :$response:\n";
+ &LONCAPA_INTENAL_DEBUG("Removed ws now :$response:");
}
+
&LONCAPA_INTERNAL_DEBUG(" type is $type ");
if ($type eq 'cs' || $type eq 'ci') {
#for string answers make surec all places spaces occur, there is
@@ -113,7 +178,7 @@
if (length($response) > 500) { return "TOO_LONG: Answer too long"; }
if ($type eq '' ) {
- $message .= "Didn't find a type :$type: defaulting\n";
+ &LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting");
if ( $answer eq ($answer *1.0)) { $type = 2;
} else { $type = 3; }
} else {
@@ -133,7 +198,7 @@
#formula type setup the sample points
if ($type eq '8') {
($id_list,$points)=split(/@/,$samples);
- $message.="Found :$id_list:$points: points in $samples\n";
+ &LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples");
}
if ($tol eq '') {
$tol=0.0;
@@ -185,7 +250,8 @@
elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; }
else {$result = "ERROR: Unknown Result:$result:$@:";}
- return ("$result:\nRetError $reterror:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message",$reterror);
+ &LONCAPA_INTERNAL_DEBUG("RetError $reterror: Answer $answer: Response $response: type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|",$reterror);
+ return ($result,$reterror)
}
sub maxima_cas_formula_fix {
@@ -229,19 +295,21 @@
&LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args));
my @responselist;
my $type = $LONCAPA::CAPAresponse_args{'type'};
- $result.="Got type :$type:\n";
- if ($type ne '' && $#LONCAPA::CAPAresponse_answer > 0) {
+ &LONCAPA_INTERNAL_DEBUG("Got type :$type:\n");
+ my $num_answers = scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}});
+ if ($type ne ''
+ && $num_answers > 1) {
(@responselist)=split(/,/,$response);
- if (@responselist < @LONCAPA::CAPAresponse_answer) {
+ if (@responselist < $num_answers) {
return 'MISSING_ANSWER';
}
- if (@responselist > @LONCAPA::CAPAresponse_answer) {
+ if (@responselist > $num_answers) {
return 'EXTRA_ANSWER';
}
} else {
(@responselist)=($response);
}
- $result.="Initial final response :$responselist['-1']:\n";
+ &LONCAPA_INTERNAL_DEBUG("Initial final response :$responselist['-1']:");
my $unit;
if ($type eq '' || $type eq 'float') {
#for numerical problems split off the unit
@@ -250,34 +318,47 @@
$unit=$2;
}
}
- $result.="Final final response :$responselist['-1']:$unit:\n";
+ &LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:");
$unit=~s/\s//;
- my ($awards, @msgs, $i);
- foreach my $thisanswer (@LONCAPA::CAPAresponse_answer) {
- my ($msg,$aresult);
- $result.="trying answer :$thisanswer:\n";
- if (defined($thisanswer)) {
- if ($unit eq '') {
- ($aresult,$msg)=&caparesponse_check($thisanswer,
- $responselist[$i]);
+ #&reset_caparesponse_memoization();
+ my ($final_award,$final_msg);
+ &init_permutation(scalar(@responselist),
+ $LONCAPA::CAPAresponse_answer->{'type'});
+ while( &get_permutations_left() ) {
+ my @responses_ordered = @responselist[&get_next_permutation()];
+ my (@awards, @msgs, $i);
+ foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) {
+ my ($msg,$aresult);
+ if (defined($thisanswer)) {
+ my $response = $responses_ordered[$i];
+ if ($unit eq '') {
+ $response .= " $unit";
+ }
+ ($aresult,$msg)=&caparesponse_check($thisanswer,$response);
} else {
- ($aresult,$msg)=&caparesponse_check($thisanswer,
- $responselist[$i]." $unit");
+ $aresult='ERROR';
+ $msg='answer was undefined';
}
+ #&LONCAPA_INTERNAL_DEBUG("after if $aresult -- $msg");
+ my ($temp)=split(/:/, $aresult);
+ push(@awards,$temp);
+ push(@msgs,$msg);
+ $i++;
+ }
+ my ($possible_award,$possible_msg) =
+ &LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs);
+ if ($final_award) {
+ ($final_award,$final_msg) =
+ &LONCAPA_INTERNAL_FINALIZEAWARDS([$final_award,$possible_award],
+ [$final_msg,$possible_msg],
+ undef,1);
} else {
- $aresult='ERROR';
- $msg='answer was undefined';
+ ($final_award,$final_msg) = ($possible_award,$possible_msg);
}
- &LONCAPA_INTERNAL_DEBUG("after if $aresult -- $msg");
- my ($temp)=split(/:/, $aresult);
- $awards.="$temp,";
- $result.=$aresult;
- push(@msgs,$msg);
- $i++;
}
- chop($awards);
- return ("$awards:\n$result",@msgs);
+ #&reset_caparesponse_memoization();
+ return ($final_award,$final_msg);
}
sub tex {
Index: loncom/homework/inputtags.pm
diff -u loncom/homework/inputtags.pm:1.205 loncom/homework/inputtags.pm:1.206
--- loncom/homework/inputtags.pm:1.205 Thu Sep 21 17:23:19 2006
+++ loncom/homework/inputtags.pm Fri Sep 29 16:55:33 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# input definitons
#
-# $Id: inputtags.pm,v 1.205 2006/09/21 21:23:19 albertel Exp $
+# $Id: inputtags.pm,v 1.206 2006/09/29 20:55:33 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -485,10 +485,14 @@
}
sub checkstatus {
- my ($value,$awardref,$msgref)=@_;
+ my ($value,$awardref,$msgref,$nameref)=@_;
for (my $i=0;$i<=$#$awardref;$i++) {
if ($$awardref[$i] eq $value) {
- return ($$awardref[$i],$$msgref[$i]);
+ if (ref($nameref)) {
+ return ($$awardref[$i],$$msgref[$i],$$nameref[$i]);
+ } else {
+ return ($$awardref[$i],$$msgref[$i]);
+ }
}
}
return(undef,undef);
@@ -513,9 +517,7 @@
sub finalizeawards {
my ($awardref,$msgref,$nameref,$reverse)=@_;
- my $result=undef;
- my $award;
- my $msg;
+ my ($result,$award,$msg,$name);
if ($#$awardref == -1) { $result = "NO_RESPONSE"; }
if ($result eq '' ) {
my $blankcount;
@@ -541,8 +543,9 @@
'APPROX_ANS', 'EXACT_ANS');
if ($reverse) { @awards=reverse(@awards); }
foreach my $possibleaward (@awards) {
- ($result,$msg)=&checkstatus($possibleaward,$awardref,$msgref);
- if (defined($result)) { return ($result,$msg); }
+ ($result,$msg,$name)=&checkstatus($possibleaward,$awardref,$msgref,
+ $nameref);
+ if (defined($result)) { return ($result,$msg,$name); }
}
return ('ERROR',undef);
}
Index: loncom/homework/structuretags.pm
diff -u loncom/homework/structuretags.pm:1.365 loncom/homework/structuretags.pm:1.366
--- loncom/homework/structuretags.pm:1.365 Wed Sep 27 18:42:25 2006
+++ loncom/homework/structuretags.pm Fri Sep 29 16:55:33 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# definition of tags that give a structure to a document
#
-# $Id: structuretags.pm,v 1.365 2006/09/27 22:42:25 albertel Exp $
+# $Id: structuretags.pm,v 1.366 2006/09/29 20:55:33 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -594,9 +594,6 @@
}
if ($target ne 'analyze') {
- if ($target eq 'web') {
- &Apache::lonhomework::showhash(%Apache::lonhomework::history);
- }
if ($env{'request.state'} eq 'construct') { &set_problem_state('0'); }
$Apache::lonhomework::type=&Apache::lonnet::EXT('resource.0.type');
if (($env{'request.state'} eq 'construct') &&
@@ -618,6 +615,10 @@
$Apache::lonhomework::default_type = $Apache::lonhomework::type;
&initialize_storage();
+ if ($target eq 'web') {
+ &Apache::lonxml::debug(" grading history ");
+ &Apache::lonhomework::showhash(%Apache::lonhomework::history);
+ }
#added vars to the scripting enviroment
my $expression='$external::part=\''.$Apache::inputtags::part.'\';';
Index: loncom/homework/caparesponse/caparesponse.pm
diff -u loncom/homework/caparesponse/caparesponse.pm:1.193 loncom/homework/caparesponse/caparesponse.pm:1.194
--- loncom/homework/caparesponse/caparesponse.pm:1.193 Mon Jul 3 10:21:45 2006
+++ loncom/homework/caparesponse/caparesponse.pm Fri Sep 29 16:55:36 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# caparesponse definition
#
-# $Id: caparesponse.pm,v 1.193 2006/07/03 14:21:45 albertel Exp $
+# $Id: caparesponse.pm,v 1.194 2006/09/29 20:55:36 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,9 +33,10 @@
use Apache::lonmaxima();
use Apache::lonlocal;
use Apache::lonnet;
+use Storable qw(dclone);
BEGIN {
- &Apache::lonxml::register('Apache::caparesponse',('caparesponse','numericalresponse','stringresponse','formularesponse'));
+ &Apache::lonxml::register('Apache::caparesponse',('numericalresponse','stringresponse','formularesponse'));
}
my %answer;
@@ -65,15 +66,21 @@
sub start_answergroup {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
my $result;
- my $id = $Apache::inputtags::response[-1];
- my $dis = &Apache::lonxml::get_param('answerdisplay',$parstack,$safeeval);
- if (defined($dis)) { $Apache::inputtags::answertxt{$id}=$dis; }
return $result;
}
sub end_answergroup {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
my $result;
+ if ($target eq 'web') {
+ if ( &Apache::response::show_answer() ) {
+ my $partid = $Apache::inputtags::part;
+ my $id = $Apache::inputtags::response[-1];
+ &set_answertext($Apache::lonhomework::history{"resource.$partid.$id.answername"},
+ $target,$token,$tagstack,$parstack,$parser,
+ $safeeval,-2);
+ }
+ }
return $result;
}
@@ -184,42 +191,55 @@
if ($unit =~ /\S/) { $result.=" (in $unit) "; }
}
if ( &Apache::response::show_answer() ) {
- my $answertxt;
- my (@answers)=&Apache::lonxml::get_param_var('answer',$parstack,
- $safeeval);
- my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,
- $safeeval);
- my $unit=&Apache::lonxml::get_param_var('unit',$parstack,
- $safeeval);
- for (my $i=0; $i <= $#answers; $i++) {
- my $answer=$answers[$i];
- if ( scalar(@$tagstack)
- && $tagstack->[-1] ne 'numericalresponse') {
- $answertxt.=$answer.',';
- } else {
- my $format;
- if ($#formats > 0) {
- $format=$formats[$i];
- } else {
- $format=$formats[0];
- }
- if ($unit=~/\$/) { $format="\$".$format; $unit=~s/\$//g; }
- if ($unit=~/\,/) { $format="\,".$format; $unit=~s/\,//g; }
- my $formatted=&format_number($answer,$format,$target,
- $safeeval);
- $answertxt.=$formatted.',';
- }
- }
- chop $answertxt;
- if ($target eq 'web') {
- $answertxt.=" $unit ";
- }
- $Apache::inputtags::answertxt{$id}=$answertxt;
+ &set_answertext('INTERNAL',$target,$token,$tagstack,$parstack,
+ $parser,$safeeval,-1);
}
}
return $result;
}
+sub set_answertext {
+ my ($name,$target,$token,$tagstack,$parstack,$parser,$safeeval,
+ $response_level) = @_;
+ my $answertxt;
+ &add_in_tag_answer($parstack,$safeeval,$response_level);
+
+ return if ($name eq '' || !ref($answer{$name}));
+
+ my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,
+ $safeeval,$response_level);
+ my $unit=&Apache::lonxml::get_param_var('unit',$parstack,$safeeval,
+ $response_level);
+
+ &Apache::lonxml::debug("answer looks to be $name");
+ for (my $i=0; $i < scalar(@{$answer{$name}{'answers'}}); $i++) {
+ my $answer=$answer{$name}{'answers'}[$i];
+ if ( scalar(@$tagstack)
+ && $tagstack->[$response_level] ne 'numericalresponse') {
+ $answertxt.=$answer.',';
+ } else {
+ my $format;
+ if ($#formats > 0) {
+ $format=$formats[$i];
+ } else {
+ $format=$formats[0];
+ }
+ if ($unit=~/\$/) { $format="\$".$format; $unit=~s/\$//g; }
+ if ($unit=~/\,/) { $format="\,".$format; $unit=~s/\,//g; }
+ my $formatted=&format_number($answer,$format,$target,
+ $safeeval);
+ $answertxt.=$formatted.',';
+ }
+ }
+
+ chop($answertxt);
+ if ($target eq 'web') {
+ $answertxt.=" $unit ";
+ }
+ my $id = $Apache::inputtags::response[-1];
+ $Apache::inputtags::answertxt{$id}=$answertxt;
+}
+
sub check_submission {
my ($response,$partid,$id,$tag,$parstack,$safeeval,$ignore_sig)=@_;
my $args_ref= \%{$safeeval->varglob('LONCAPA::CAPAresponse_args')};
@@ -257,18 +277,16 @@
} elsif ($tag eq 'numericalresponse') {
$$args_ref{'type'}='float';
}
- my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval);
- &Apache::lonxml::debug('answer is'.join(':',@answer));
- if (@answer && defined($answer[0])) {
- $answer{'INTERNAL'}= {'type' => 'ordered',
- 'answers' => \@answer };
- }
- #FIXME would be nice if we could save name so we know who graded him
- #correct
+
+ &add_in_tag_answer($parstack,$safeeval);
+
+ #FIXME would be nice if we could save name so we know which answer
+ # graded the users submisson correct
my (%results,@final_awards,@final_msgs,@names);
foreach my $name (keys(%answer)) {
&Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} }));
- @{$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=@{ $answer{$name}{'answers'} };
+
+ ${$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=dclone($answer{$name});
my ($result,@msgs) =
&Apache::run::run("&caparesponse_check_list()",$safeeval);
&Apache::lonxml::debug('msgs are '.join(':',@msgs));
@@ -283,7 +301,19 @@
my ($ad, $msg, $name) = &Apache::inputtags::finalizeawards(\@final_awards,
\@final_msgs,
\@names,1);
- return($ad,$msg);
+ &Apache::lonxml::debug(" name of picked award is $name from ".join(', ',@names));
+ return($ad,$msg, $name);
+}
+
+sub add_in_tag_answer {
+ my ($parstack,$safeeval,$response_level) = @_;
+ my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval,
+ $response_level);
+ &Apache::lonxml::debug('answer is'.join(':',@answer));
+ if (@answer && defined($answer[0])) {
+ $answer{'INTERNAL'}= {'type' => 'ordered',
+ 'answers' => \@answer };
+ }
}
sub end_numericalresponse {
@@ -319,8 +349,9 @@
$response=$values->[$response];
}
$Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response;
- my ($ad,$msg)=&check_submission($response,$partid,$id,
- $tag,$parstack,$safeeval);
+ my ($ad,$msg,$name)=&check_submission($response,$partid,$id,
+ $tag,$parstack,
+ $safeeval);
&Apache::lonxml::debug('ad is'.$ad);
if ($ad eq 'SIG_FAIL') {
@@ -339,15 +370,16 @@
&Apache::response::handle_previous(\%previous,$ad);
$Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}=$ad;
$Apache::lonhomework::results{"resource.$partid.$id.awardmsg"}=$msg;
+ $Apache::lonhomework::results{"resource.$partid.$id.answername"}=$name;
$result='';
}
}
} elsif ($target eq 'web' || $target eq 'tex') {
- my (@answers)=&Apache::lonxml::get_param_var('answer',$parstack,
- $safeeval);
my $award = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
my $status = $Apache::inputtags::status['-1'];
if ($Apache::lonhomework::type eq 'exam') {
+ # FIXME support multi dimensional numerical problems
+ # in exam bubbles
my ($bubble_values,$bubble_display)=
&make_numerical_bubbles($partid,$id,$target,$parstack,
$safeeval);
@@ -418,10 +450,10 @@
if (scalar(@$tagstack)) {
&Apache::response::setup_params($tag,$safeeval);
}
- my (@answers)=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval);
+ &add_in_tag_answer($parstack,$safeeval);
my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);
+
my $unit=&Apache::lonxml::get_param_var('unit',$parstack,$safeeval);
- my $type=&Apache::lonxml::get_param('type',$parstack,$safeeval);
if ($target eq 'answer') {
$result.=&Apache::response::answer_header($tag);
@@ -432,121 +464,124 @@
$result.=&Apache::response::answer_part($tag,$correct);
}
}
- my ($sigline,$tolline);
- for(my $i=0;$i<=$#answers;$i++) {
- my $ans=$answers[$i];
- my $fmt=$formats[0];
- if (@formats && $#formats) {$fmt=$formats[$i];}
- my ($high,$low);
- if ($Apache::inputtags::params{'tol'}) {
- ($high,$low)=&get_tolrange($ans,$Apache::inputtags::params{'tol'});
- }
- my ($sighigh,$siglow);
- if ($Apache::inputtags::params{'sig'}) {
- ($sighigh,$siglow)=&get_sigrange($Apache::inputtags::params{'sig'});
- }
- if ($fmt && $tag eq 'numericalresponse') {
- $fmt=~s/e/E/g;
- if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; }
- if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; }
- $ans = &format_number($ans,$fmt,$target,$safeeval);
- #if ($high) {
- # $high=&format_number($high,$fmt,$target,$safeeval);
- # $low =&format_number($low,$fmt,$target,$safeeval);
- #}
- }
- if ($target eq 'answer') {
- if ($high && $tag eq 'numericalresponse') {
- $ans.=' ['.$low.','.$high.']';
- $tolline .= "[$low, $high]";
- }
- if (defined($sighigh) && $tag eq 'numericalresponse') {
- if ($env{'form.answer_output_mode'} eq 'tex') {
- $ans.= " Sig $siglow - $sighigh";
- } else {
- $ans.= " Sig <i>$siglow - $sighigh</i>";
- $sigline .= "[$siglow, $sighigh]";
+ foreach my $name (sort(keys(%answer))) {
+ my @answers = @{ $answer{$name}{'answers'} };
+ my ($sigline,$tolline);
+ for(my $i=0;$i<=$#answers;$i++) {
+ my $ans=$answers[$i];
+ my $fmt=$formats[0];
+ if (@formats && $#formats) {$fmt=$formats[$i];}
+ my ($high,$low);
+ if ($Apache::inputtags::params{'tol'}) {
+ ($high,$low)=&get_tolrange($ans,$Apache::inputtags::params{'tol'});
+ }
+ my ($sighigh,$siglow);
+ if ($Apache::inputtags::params{'sig'}) {
+ ($sighigh,$siglow)=&get_sigrange($Apache::inputtags::params{'sig'});
+ }
+ if ($fmt && $tag eq 'numericalresponse') {
+ $fmt=~s/e/E/g;
+ if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; }
+ if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; }
+ $ans = &format_number($ans,$fmt,$target,$safeeval);
+ #if ($high) {
+ # $high=&format_number($high,$fmt,$target,$safeeval);
+ # $low =&format_number($low,$fmt,$target,$safeeval);
+ #}
+ }
+ if ($target eq 'answer') {
+ if ($high && $tag eq 'numericalresponse') {
+ $ans.=' ['.$low.','.$high.']';
+ $tolline .= "[$low, $high]";
+ }
+ if (defined($sighigh) && $tag eq 'numericalresponse') {
+ if ($env{'form.answer_output_mode'} eq 'tex') {
+ $ans.= " Sig $siglow - $sighigh";
+ } else {
+ $ans.= " Sig <i>$siglow - $sighigh</i>";
+ $sigline .= "[$siglow, $sighigh]";
+ }
+ }
+ $result.=&Apache::response::answer_part($tag,$ans);
+ } elsif ($target eq 'analyze') {
+ push (@{ $Apache::lonhomework::analyze{"$part_id.answer"} }, $ans);
+ if ($high) {
+ push (@{ $Apache::lonhomework::analyze{"$part_id.ans_high"} }, $high);
+ push (@{ $Apache::lonhomework::analyze{"$part_id.ans_low"} }, $low);
+ }
+ if ($fmt) {
+ push (@{ $Apache::lonhomework::analyze{"$part_id.format"} }, $fmt);
}
- }
- $result.=&Apache::response::answer_part($tag,$ans);
- } elsif ($target eq 'analyze') {
- push (@{ $Apache::lonhomework::analyze{"$part_id.answer"} }, $ans);
- if ($high) {
- push (@{ $Apache::lonhomework::analyze{"$part_id.ans_high"} }, $high);
- push (@{ $Apache::lonhomework::analyze{"$part_id.ans_low"} }, $low);
- }
- if ($fmt) {
- push (@{ $Apache::lonhomework::analyze{"$part_id.format"} }, $fmt);
}
}
- }
- my @fmt_ans;
- for(my $i=0;$i<=$#answers;$i++) {
- my $ans=$answers[$i];
- my $fmt=$formats[0];
- if (@formats && $#formats) {$fmt=$formats[$i];}
- if ($fmt && $tag eq 'numericalresponse') {
- $fmt=~s/e/E/g;
- if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; }
- if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; }
- $ans = &format_number($ans,$fmt,$target,$safeeval);
- if ($fmt=~/\$/ && $unit!~/\$/) { $ans=~s/\$//; }
- }
- push(@fmt_ans,$ans);
- }
- my $response=join(', ',@fmt_ans);
- my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.
- $id.'.turnoffunit');
- if ($unit ne '' &&
- ! ($Apache::lonhomework::type eq 'exam' ||
- lc($hideunit) eq "yes") ) {
- my $cleanunit=$unit;
- $cleanunit=~s/\$\,//g;
- $response.=" $cleanunit";
- }
-
- my ($ad,$msg)=&check_submission($response,$partid,$id,$tag,
- $parstack,$safeeval);
- if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
- my $error;
- if ($tag eq 'formularesponse') {
- $error=&mt('Computer\'s answer is incorrect ("[_1]").',$response);
- } else {
- # answer failed check if it is sig figs that is failing
- my ($ad,$msg)=&check_submission($response,$partid,$id,
- $tag,$parstack,
- $safeeval,1);
- if ($sigline ne '') {
- $error=&mt('Computer\'s answer is incorrect ("[_1]"). It is likely that the tolerance range [_2] or significant figures [_3] need to be adjusted.',$response,$tolline,$sigline);
- } else {
- $error=&mt('Computer\'s answer is incorrect ("[_1]"). It is likely that the tolerance range [_2] needs to be adjusted.',$response,$tolline);
- }
+ my @fmt_ans;
+ for(my $i=0;$i<=$#answers;$i++) {
+ my $ans=$answers[$i];
+ my $fmt=$formats[0];
+ if (@formats && $#formats) {$fmt=$formats[$i];}
+ if ($fmt && $tag eq 'numericalresponse') {
+ $fmt=~s/e/E/g;
+ if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; }
+ if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; }
+ $ans = &format_number($ans,$fmt,$target,$safeeval);
+ if ($fmt=~/\$/ && $unit!~/\$/) { $ans=~s/\$//; }
+ }
+ push(@fmt_ans,$ans);
+ }
+ my $response=join(', ',@fmt_ans);
+ my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.
+ $id.'.turnoffunit');
+ if ($unit ne '' &&
+ ! ($Apache::lonhomework::type eq 'exam' ||
+ lc($hideunit) eq "yes") ) {
+ my $cleanunit=$unit;
+ $cleanunit=~s/\$\,//g;
+ $response.=" $cleanunit";
}
+
+ my ($ad,$msg)=&check_submission($response,$partid,$id,$tag,
+ $parstack,$safeeval);
if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
- &Apache::lonxml::error($error);
- } else {
- &Apache::lonxml::warning($error);
+ my $error;
+ if ($tag eq 'formularesponse') {
+ $error=&mt('Computer\'s answer is incorrect ("[_1]").[_2]',$response,$name);
+ } else {
+ # answer failed check if it is sig figs that is failing
+ my ($ad,$msg)=&check_submission($response,$partid,$id,
+ $tag,$parstack,
+ $safeeval,1);
+ if ($sigline ne '') {
+ $error=&mt('Computer\'s answer is incorrect ("[_1]"). It is likely that the tolerance range [_2] or significant figures [_3] need to be adjusted.[_4]',$response,$tolline,$sigline,$name);
+ } else {
+ $error=&mt('Computer\'s answer is incorrect ("[_1]"). It is likely that the tolerance range [_2] needs to be adjusted.[_3]',$response,$tolline,$name);
+ }
+ }
+ if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
+ &Apache::lonxml::error($error);
+ } else {
+ &Apache::lonxml::warning($error);
+ }
}
- }
- if (defined($unit) and ($unit ne '') and
- $tag eq 'numericalresponse') {
- if ($target eq 'answer') {
- if ($env{'form.answer_output_mode'} eq 'tex') {
- $result.=&Apache::response::answer_part($tag,
- " Unit: $unit ");
- } else {
- $result.=&Apache::response::answer_part($tag,
- "Unit: <b>$unit</b>");
+ if (defined($unit) and ($unit ne '') and
+ $tag eq 'numericalresponse') {
+ if ($target eq 'answer') {
+ if ($env{'form.answer_output_mode'} eq 'tex') {
+ $result.=&Apache::response::answer_part($tag,
+ " Unit: $unit ");
+ } else {
+ $result.=&Apache::response::answer_part($tag,
+ "Unit: <b>$unit</b>");
+ }
+ } elsif ($target eq 'analyze') {
+ push (@{ $Apache::lonhomework::analyze{"$part_id.unit"} }, $unit);
}
- } elsif ($target eq 'analyze') {
- push (@{ $Apache::lonhomework::analyze{"$part_id.unit"} }, $unit);
}
- }
- if ($tag eq 'formularesponse' && $target eq 'answer') {
- my $samples=&Apache::lonxml::get_param('samples',$parstack,$safeeval);
- $result.=&Apache::response::answer_part($tag,$samples);
+ if ($tag eq 'formularesponse' && $target eq 'answer') {
+ my $samples=&Apache::lonxml::get_param('samples',$parstack,$safeeval);
+ $result.=&Apache::response::answer_part($tag,$samples);
+ }
}
if ($target eq 'answer') {
$result.=&Apache::response::answer_footer($tag);
Index: loncom/homework/caparesponse/test.pl
diff -u loncom/homework/caparesponse/test.pl:1.2 loncom/homework/caparesponse/test.pl:1.3
--- loncom/homework/caparesponse/test.pl:1.2 Mon Jan 31 16:53:51 2005
+++ loncom/homework/caparesponse/test.pl Fri Sep 29 16:55:36 2006
@@ -1,14 +1,70 @@
use strict;
-use capa;
+use warnings;
-my $unit="N";
-my $answer="3.4 N";
-my $scaled="3.2";
-print("\n return code is (should be 6)".&capa::caparesponse_get_real_response($unit,$answer,\$scaled));
-print("\nscaled (should be 0.0034) ".$scaled." unit $unit answer $answer");
-$unit="m";
-$answer="3.4 mm/J";
-$scaled=3.2;
-print("\n return code is (should be 15)".&capa::caparesponse_get_real_response($unit,$answer,\$scaled));
-print("\nscaled (should be 3.2) ".$scaled." unit $unit answer $answer");
-print("\n");
+my $n = 0;
+my $total = 0;
+my $num_left = 0;
+my @order;
+
+sub factorial {
+ my $input = CORE::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 init {
+ my ($size) = @_;
+ @order = (0..$size-1);
+ $n = $size;
+ $total = $num_left = &factorial($size);
+}
+
+sub get_next {
+ if ($num_left == $total) {
+ $num_left--;
+ return @order;
+ }
+
+
+ # Find largest index j with a[j] < a[j+1]
+
+ my $j = scalar(@order) - 2;
+ while ($order[$j] > $order[$j+1]) {
+ $j--;
+ }
+
+ # Find index k such that a[k] is smallest integer
+ # greater than a[j] to the right of a[j]
+
+ my $k = scalar(@order) - 1;
+ while ($order[$j] > $order[$k]) {
+ $k--;
+ }
+
+ # Interchange a[j] and a[k]
+
+ @order[($k,$j)] = @order[($j,$k)];
+
+ # Put tail end of permutation after jth position in increasing order
+
+ my $r = scalar(@order) - 1;
+ my $s = $j + 1;
+
+ while ($r > $s) {
+ @order[($s,$r)]=@order[($r,$s)];
+ $r--;
+ $s++;
+ }
+
+ $num_left--;
+ return(@order);
+}
+
+&init(9);
+while($num_left) {
+ print(join(':',&get_next()).$/);
+}
--albertel1159563336--