--- loncom/homework/caparesponse/caparesponse.pm 2006/07/03 14:21:45 1.193
+++ loncom/homework/caparesponse/caparesponse.pm 2006/09/29 20:55:36 1.194
@@ -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 Safe::Hole;
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 end_answer {
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 @@ sub start_numericalresponse {
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 @@ sub check_submission {
} 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 @@ sub check_submission {
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 @@ sub end_numericalresponse {
$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 @@ sub end_numericalresponse {
&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 @@ sub end_numericalresponse {
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 @@ sub end_numericalresponse {
$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 $siglow - $sighigh";
- $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 $siglow - $sighigh";
+ $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/\$//; }
+ 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";
}
- 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);
+
+ 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]").[_2]',$response,$name);
} else {
- $error=&mt('Computer\'s answer is incorrect ("[_1]"). It is likely that the tolerance range [_2] needs to be adjusted.',$response,$tolline);
+ # 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 ($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: $unit");
+ 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: $unit");
+ }
+ } 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);