--- loncom/homework/caparesponse/caparesponse.pm 2006/09/29 20:55:36 1.194
+++ loncom/homework/caparesponse/caparesponse.pm 2006/11/01 23:24:52 1.195
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# caparesponse definition
#
-# $Id: caparesponse.pm,v 1.194 2006/09/29 20:55:36 albertel Exp $
+# $Id: caparesponse.pm,v 1.195 2006/11/01 23:24:52 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -41,6 +41,8 @@ BEGIN {
my %answer;
my $cur_name;
+my $tag_internal_answer_name = 'INTERNAL';
+
sub start_answer {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
my $result;
@@ -93,7 +95,9 @@ sub start_value {
my $bodytext = &Apache::lonxml::get_all_text("/value",$parser,$style);
$bodytext = &Apache::run::evaluate($bodytext,$safeeval,
$$parstack[-1]);
- push(@{ $answer{$cur_name}{'answers'} },$bodytext);
+
+ push(@{ $answer{$cur_name}{'answers'} },[$bodytext]);
+
}
return $result;
}
@@ -104,6 +108,28 @@ sub end_value {
return $result;
}
+sub start_vector {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+ my $result;
+ if ( $target eq 'web' || $target eq 'tex' ||
+ $target eq 'grade' || $target eq 'webgrade' ||
+ $target eq 'answer' || $target eq 'analyze' ) {
+ my $bodytext = &Apache::lonxml::get_all_text("/vector",$parser,$style);
+ my @values = &Apache::run::run($bodytext,$safeeval,$$parstack[-1]);
+ if (@values == 1) {
+ @values = split(',',$values[0]);
+ }
+ push(@{ $answer{$cur_name}{'answers'} },\@values);
+ }
+ return $result;
+}
+
+sub end_vector {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
+ my $result;
+ return $result;
+}
+
sub start_array {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result;
@@ -138,7 +164,9 @@ sub end_unit {
sub start_numericalresponse {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
- &Apache::lonxml::register('Apache::caparesponse',('answer','answergroup','value','array','unit'));
+ &Apache::lonxml::register('Apache::caparesponse',
+ ('answer','answergroup','value','array','unit',
+ 'vector'));
my $id = &Apache::response::start_response($parstack,$safeeval);
my $result;
undef(%answer);
@@ -191,8 +219,8 @@ sub start_numericalresponse {
if ($unit =~ /\S/) { $result.=" (in $unit) "; }
}
if ( &Apache::response::show_answer() ) {
- &set_answertext('INTERNAL',$target,$token,$tagstack,$parstack,
- $parser,$safeeval,-1);
+ &set_answertext($tag_internal_answer_name,$target,$token,$tagstack,
+ $parstack,$parser,$safeeval,-1);
}
}
return $result;
@@ -201,7 +229,6 @@ sub start_numericalresponse {
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}));
@@ -212,50 +239,78 @@ sub set_answertext {
$response_level);
&Apache::lonxml::debug("answer looks to be $name");
+ my @answertxt;
for (my $i=0; $i < scalar(@{$answer{$name}{'answers'}}); $i++) {
+ my $answertxt;
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];
+ foreach my $element (@$answer) {
+ if ( scalar(@$tagstack)
+ && $tagstack->[$response_level] ne 'numericalresponse') {
+ $answertxt.=$element.',';
} else {
- $format=$formats[0];
+ 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($element,$format,$target,
+ $safeeval);
+ $answertxt.=' '.$formatted.',';
}
- 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 ";
}
+
+ push(@answertxt,$answertxt)
}
- chop($answertxt);
- if ($target eq 'web') {
- $answertxt.=" $unit ";
- }
my $id = $Apache::inputtags::response[-1];
- $Apache::inputtags::answertxt{$id}=$answertxt;
+ $Apache::inputtags::answertxt{$id}=\@answertxt;
}
-sub check_submission {
- my ($response,$partid,$id,$tag,$parstack,$safeeval,$ignore_sig)=@_;
+sub setup_capa_args {
+ my ($safeeval,$parstack,$args,$response) = @_;
my $args_ref= \%{$safeeval->varglob('LONCAPA::CAPAresponse_args')};
- $$args_ref{'response'}=$response;
- my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffunit');
-
- foreach my $arg ('type','tol','sig','format','unit','calc',
- 'samples') {
+ undef(%{ $args_ref });
+
+ foreach my $arg (@{$args}) {
$$args_ref{$arg}=
&Apache::lonxml::get_param($arg,$parstack,$safeeval);
}
foreach my $key (keys(%Apache::inputtags::params)) {
$$args_ref{$key}=$Apache::inputtags::params{$key};
}
+ &setup_capa_response($args_ref,$response);
+ return $args_ref;
+}
+
+sub setup_capa_response {
+ my ($args_ref,$response) = @_;
+
+ use Data::Dumper;
+ &Apache::lonxml::debug("response dump is ".&Dumper($response));
- #no way to enter units, with radio buttons
+ if (ref($response)) {
+ $$args_ref{'response'}=dclone($response);
+ } else {
+ $$args_ref{'response'}=dclone([$response]);
+ }
+}
+
+sub check_submission {
+ my ($response,$partid,$id,$tag,$parstack,$safeeval,$ignore_sig)=@_;
+ my @args = ('type','tol','sig','format','unit','calc','samples');
+ my $args_ref = &setup_capa_args($safeeval,$parstack,\@args,$response);
+
+ my $hideunit=
+ &Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffunit');
+ #no way to enter units, with radio buttons
if ($Apache::lonhomework::type eq 'exam' ||
lc($hideunit) eq "yes") {
delete($$args_ref{'unit'});
@@ -280,20 +335,21 @@ sub check_submission {
&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);
+ my (@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')}=dclone($answer{$name});
+ &setup_capa_response($args_ref,$response);
+ use Time::HiRes;
+ my $t0 = [Time::HiRes::gettimeofday()];
my ($result,@msgs) =
&Apache::run::run("&caparesponse_check_list()",$safeeval);
+ &Apache::lonxml::debug("checking $name $result with $response took ".&Time::HiRes::tv_interval($t0));
&Apache::lonxml::debug('msgs are '.join(':',@msgs));
my ($awards)=split(/:/,$result);
my @awards= split(/,/,$awards);
my ($ad, $msg) = &Apache::inputtags::finalizeawards(\@awards,\@msgs);
- $results{$name}= [$ad,$msg];
push(@final_awards,$ad);
push(@final_msgs,$msg);
push(@names,$name);
@@ -311,8 +367,8 @@ sub add_in_tag_answer {
$response_level);
&Apache::lonxml::debug('answer is'.join(':',@answer));
if (@answer && defined($answer[0])) {
- $answer{'INTERNAL'}= {'type' => 'ordered',
- 'answers' => \@answer };
+ $answer{$tag_internal_answer_name}= {'type' => 'ordered',
+ 'answers' => [\@answer] };
}
}
@@ -456,7 +512,8 @@ sub end_numericalresponse {
my $unit=&Apache::lonxml::get_param_var('unit',$parstack,$safeeval);
if ($target eq 'answer') {
- $result.=&Apache::response::answer_header($tag);
+ $result.=&Apache::response::answer_header($tag,undef,
+ scalar(keys(%answer)));
if ($tag eq 'numericalresponse'
&& $Apache::lonhomework::type eq 'exam') {
my ($bubble_values,undef,$correct) = &make_numerical_bubbles($partid,
@@ -467,43 +524,61 @@ sub end_numericalresponse {
foreach my $name (sort(keys(%answer))) {
my @answers = @{ $answer{$name}{'answers'} };
my ($sigline,$tolline);
+ if ($name ne $tag_internal_answer_name
+ || scalar(keys(%answer)) > 1) {
+ $result.=&Apache::response::answer_part($tag,$name);
+ }
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);
- #}
+ my @vector;
+ if (ref($ans)) {
+ @vector = @{ $ans };
+ } else {
+ @vector = ($ans);
}
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]";
+ my @all_answer_info;
+ foreach my $element (@vector) {
+ my ($high,$low);
+ if ($Apache::inputtags::params{'tol'}) {
+ ($high,$low)=&get_tolrange($element,$Apache::inputtags::params{'tol'});
+ }
+ if ($fmt && $tag eq 'numericalresponse') {
+ $fmt=~s/e/E/g;
+ if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; }
+ if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; }
+ $element = &format_number($element,$fmt,$target,$safeeval);
+ #if ($high) {
+ # $high=&format_number($high,$fmt,$target,$safeeval);
+ # $low =&format_number($low,$fmt,$target,$safeeval);
+ #}
}
+ if ($high && $tag eq 'numericalresponse') {
+ $element.=' ['.$low.','.$high.']';
+ $tolline .= "[$low, $high]";
+ }
+ if (defined($sighigh) && $tag eq 'numericalresponse') {
+ if ($env{'form.answer_output_mode'} eq 'tex') {
+ $element.= " Sig $siglow - $sighigh";
+ } else {
+ $element.= " Sig $siglow - $sighigh";
+ $sigline .= "[$siglow, $sighigh]";
+ }
+ }
+ push(@all_answer_info,$element);
}
- $result.=&Apache::response::answer_part($tag,$ans);
+ $result.= &Apache::response::answer_part($tag,join(', ',@all_answer_info));
} elsif ($target eq 'analyze') {
+ my ($high,$low);
+ if ($Apache::inputtags::params{'tol'}) {
+ ($high,$low)=&get_tolrange($ans,$Apache::inputtags::params{'tol'});
+ }
push (@{ $Apache::lonhomework::analyze{"$part_id.answer"} }, $ans);
if ($high) {
push (@{ $Apache::lonhomework::analyze{"$part_id.ans_high"} }, $high);
@@ -520,16 +595,20 @@ sub end_numericalresponse {
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/\$//; }
+ foreach my $element (@$ans) {
+ if ($fmt && $tag eq 'numericalresponse') {
+ $fmt=~s/e/E/g;
+ if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; }
+ if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; }
+ $element = &format_number($element,$fmt,$target,
+ $safeeval);
+ if ($fmt=~/\$/ && $unit!~/\$/) { $element=~s/\$//; }
+ }
}
- push(@fmt_ans,$ans);
+ push(@fmt_ans,join(',',@$ans));
}
- my $response=join(', ',@fmt_ans);
+ my $response=\@fmt_ans;
+
my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.
$id.'.turnoffunit');
if ($unit ne '' &&
@@ -537,24 +616,25 @@ sub end_numericalresponse {
lc($hideunit) eq "yes") ) {
my $cleanunit=$unit;
$cleanunit=~s/\$\,//g;
- $response.=" $cleanunit";
+ foreach my $ans (@fmt_ans) {
+ $ans.=" $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]").[_2]',$response,$name);
+ $error=&mt('Computer\'s answer is incorrect ("[_1]").',join(', ',@$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.[_4]',$response,$tolline,$sigline,$name);
+ $error=&mt('Computer\'s answer is incorrect ("[_1]"). It is likely that the tolerance range [_2] or significant figures [_3] need to be adjusted.',join(', ',@$response),$tolline,$sigline);
} 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);
+ $error=&mt('Computer\'s answer is incorrect ("[_1]"). It is likely that the tolerance range [_2] needs to be adjusted.',join(', ',@$response),$tolline);
}
}
if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
@@ -582,6 +662,7 @@ sub end_numericalresponse {
my $samples=&Apache::lonxml::get_param('samples',$parstack,$safeeval);
$result.=&Apache::response::answer_part($tag,$samples);
}
+ $result.=&Apache::response::next_answer($tag,$name);
}
if ($target eq 'answer') {
$result.=&Apache::response::answer_footer($tag);
@@ -746,7 +827,7 @@ sub get_tolrange {
sub get_sigrange {
my ($sig)=@_;
- &Apache::lonxml::debug("Got a sig of :$sig:");
+ #&Apache::lonxml::debug("Got a sig of :$sig:");
my $courseid=$env{'request.course.id'};
if (lc($env{"course.$courseid.disablesigfigs"}) eq 'yes') {
return (15,0);
@@ -810,7 +891,7 @@ sub start_stringresponse {
$answer=
&Apache::lonxml::get_param('answer',$parstack,$safeeval);
}
- $Apache::inputtags::answertxt{$id}=$answer;
+ $Apache::inputtags::answertxt{$id}=[$answer];
}
} elsif ($target eq 'answer' || $target eq 'grade') {
&Apache::response::reset_params();
@@ -861,24 +942,30 @@ sub end_stringresponse {
&Apache::lonxml::debug("current $answer");
$ad = ($result) ? 'APPROX_ANS' : 'INCORRECT';
} else {
- my $args_ref=
- \%{$safeeval->varglob('LONCAPA::CAPAresponse_args')};
-
- $$args_ref{'response'}=$response;
- &Apache::lonxml::debug("current $response");
- $$args_ref{'type'}=
- &Apache::lonxml::get_param('type',$parstack,$safeeval);
- foreach my $key (keys(%Apache::inputtags::params)) {
- $$args_ref{$key}=$Apache::inputtags::params{$key};
+ my @args = ('type');
+ my $args_ref = &setup_capa_args($safeeval,$parstack,
+ \@args,$response);
+
+ &add_in_tag_answer($parstack,$safeeval);
+ my (@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')}=dclone($answer{$name});
+ my ($result, @msgs)=&Apache::run::run("&caparesponse_check_list()",$safeeval);
+ &Apache::lonxml::debug('msgs are'.join(':',@msgs));
+ my ($awards)=split(/:/,$result);
+ my (@awards) = split(/,/,$awards);
+ ($ad,$msg) =
+ &Apache::inputtags::finalizeawards(\@awards,\@msgs);
+ push(@final_awards,$ad);
+ push(@final_msgs,$msg);
+ push(@names,$name);
+ &Apache::lonxml::debug("\n
result:$result:$Apache::lonxml::curdepth
\n");
}
- &Apache::lonxml::debug('answer is'.join(':',$answer));
- @{$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=($answer);
- ($result, my @msgs)=&Apache::run::run("&caparesponse_check_list()",$safeeval);
- &Apache::lonxml::debug('msgs are'.join(':',@msgs));
- my ($awards)=split(/:/,$result);
- my (@awards) = split(/,/,$awards);
- ($ad,$msg) = &Apache::inputtags::finalizeawards(\@awards,\@msgs);
- &Apache::lonxml::debug("\n
result:$result:$Apache::lonxml::curdepth
\n");
+ my ($ad, $msg, $name) =
+ &Apache::inputtags::finalizeawards(\@final_awards,
+ \@final_msgs,
+ \@names,1);
}
if ($Apache::lonhomework::type eq 'survey' &&
($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' ||