--- loncom/homework/caparesponse/caparesponse.pm 2005/04/07 06:56:22 1.166
+++ loncom/homework/caparesponse/caparesponse.pm 2005/12/01 22:30:55 1.183
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# caparesponse definition
#
-# $Id: caparesponse.pm,v 1.166 2005/04/07 06:56:22 albertel Exp $
+# $Id: caparesponse.pm,v 1.183 2005/12/01 22:30:55 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,11 +36,104 @@ BEGIN {
&Apache::lonxml::register('Apache::caparesponse',('caparesponse','numericalresponse','stringresponse','formularesponse'));
}
+my %answer;
+my $cur_name;
+sub start_answer {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
+ my $result;
+ $cur_name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
+ if ($cur_name =~ /^\s*$/) { $cur_name = $Apache::lonxml::curdepth; }
+ my $type = &Apache::lonxml::get_param('type',$parstack,$safeeval);
+ if (!defined($type) && $tagstack->[-2] eq 'answergroup') {
+ $type = &Apache::lonxml::get_param('type',$parstack,$safeeval,-2);
+ }
+ if (!defined($type)) { $type = 'ordered' };
+ $answer{$cur_name}= { 'type' => $type,
+ 'answers' => [] };
+ return $result;
+}
+
+sub end_answer {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
+ my $result;
+ undef($cur_name);
+ return $result;
+}
+
+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;
+ return $result;
+}
+
+sub start_value {
+ 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("/value",$parser,$style);
+ $bodytext = &Apache::run::evaluate($bodytext,$safeeval,
+ $$parstack[-1]);
+ push(@{ $answer{$cur_name}{'answers'} },$bodytext);
+ }
+ return $result;
+}
+
+sub end_value {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
+ my $result;
+ return $result;
+}
+
+sub start_array {
+ 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("/array",$parser,$style);
+ my @values = &Apache::run::evaluate($bodytext,$safeeval,
+ $$parstack[-1]);
+ push(@{ $answer{$cur_name}{'answers'} },@values);
+ }
+ return $result;
+}
+
+sub end_array {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
+ my $result;
+ return $result;
+}
+
+sub start_unit {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
+ my $result;
+ return $result;
+}
+
+sub end_unit {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
+ my $result;
+ return $result;
+}
+
sub start_numericalresponse {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
+ &Apache::lonxml::register('Apache::caparesponse',('answer','answergroup','value','array','unit'));
my $id = &Apache::response::start_response($parstack,$safeeval);
my $result;
- undef %{$safeeval->varglob('LONCAPA::CAPAresponse_args')};
+ undef(%answer);
+ undef(%{$safeeval->varglob('LONCAPA::CAPAresponse_args')});
if ($target eq 'edit') {
$result.=&Apache::edit::tag_start($target,$token);
$result.=&Apache::edit::text_arg('Answer:','answer',$token);
@@ -120,6 +213,68 @@ sub start_numericalresponse {
return $result;
}
+sub check_submission {
+ my ($response,$partid,$id,$tag,$parstack,$safeeval,$ignore_sig)=@_;
+ 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') {
+ $$args_ref{$arg}=
+ &Apache::lonxml::get_param($arg,$parstack,$safeeval);
+ }
+ foreach my $key (keys(%Apache::inputtags::params)) {
+ $$args_ref{$key}=$Apache::inputtags::params{$key};
+ }
+
+ #no way to enter units, with radio buttons
+ if ($Apache::lonhomework::type eq 'exam' ||
+ lc($hideunit) eq "yes") {
+ delete($$args_ref{'unit'});
+ }
+ #sig fig don't make much sense either
+ if (($Apache::lonhomework::type eq 'exam' ||
+ &Apache::response::submitted('scantron') ||
+ $ignore_sig) &&
+ $tag eq 'numericalresponse') {
+ delete($$args_ref{'sig'});
+ }
+
+ if ($tag eq 'formularesponse') {
+ $$args_ref{'type'}='fml';
+ } 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
+ 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'} };
+ 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);
+ my ($ad, $msg) = &Apache::inputtags::finalizeawards(\@awards,\@msgs);
+ $results{$name}= [$ad,$msg];
+ push(@final_awards,$ad);
+ push(@final_msgs,$msg);
+ push(@names,$name);
+ }
+ my ($ad, $msg, $name) = &Apache::inputtags::finalizeawards(\@final_awards,
+ \@final_msgs,
+ \@names,1);
+ return($ad,$msg);
+}
+
sub end_numericalresponse {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $increment=1;
@@ -127,20 +282,19 @@ sub end_numericalresponse {
if (!$Apache::lonxml::default_homework_loaded) {
&Apache::lonxml::default_homework_load($safeeval);
}
+ my $partid = $Apache::inputtags::part;
+ my $id = $Apache::inputtags::response[-1];
my $tag;
+ $safeeval->share_from('capa',['&caparesponse_capa_check_answer']);
if (scalar(@$tagstack)) { $tag=$$tagstack[-1]; }
if ( $target eq 'grade' && &Apache::response::submitted() ) {
&Apache::response::setup_params($tag,$safeeval);
- $safeeval->share_from('capa',['&caparesponse_capa_check_answer']);
- my $partid = $Apache::inputtags::part;
- my $id = $Apache::inputtags::response['-1'];
if ($Apache::lonhomework::type eq 'exam' &&
$tag eq 'formularesponse') {
$increment=&Apache::response::scored_response($partid,$id);
} else {
my $response = &Apache::response::getresponse();
if ( $response =~ /[^\s]/) {
- my $ad;
my %previous = &Apache::response::check_for_previous($response,$partid,$id);
&Apache::lonxml::debug("submitted a $response
\n");
&Apache::lonxml::debug($$parstack[-1] . "\n
");
@@ -156,46 +310,9 @@ sub end_numericalresponse {
$response=$values->[$response];
}
$Apache::lonhomework::results{"resource.$partid.$id.submission"}=$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') {
- $$args_ref{$arg}=
- &Apache::lonxml::get_param($arg,$parstack,$safeeval);
- }
- foreach my $key (keys(%Apache::inputtags::params)) {
- $$args_ref{$key}=$Apache::inputtags::params{$key};
- }
-
- #no way to enter units, with radio buttons
- if ($Apache::lonhomework::type eq 'exam' ||
- lc($hideunit) eq "yes") {
- delete($$args_ref{'unit'});
- }
- #sig fig don't make much sense either
- if (($Apache::lonhomework::type eq 'exam' ||
- &Apache::response::submitted('scantron')) &&
- $tag eq 'numericalresponse') {
- delete($$args_ref{'sig'});
- }
-
- if ($tag eq 'formularesponse') {
- $$args_ref{'type'}='fml';
- } 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));
- @{$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,my $msg) = &Apache::inputtags::finalizeawards(\@awards,\@msgs);
+ my ($ad,$msg)=&check_submission($response,$partid,$id,
+ $tag,$parstack,$safeeval);
+
&Apache::lonxml::debug('ad is'.$ad);
if ($ad eq 'SIG_FAIL') {
my ($sig_u,$sig_l)=
@@ -222,8 +339,6 @@ sub end_numericalresponse {
my $award = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
my $status = $Apache::inputtags::status['-1'];
if ($Apache::lonhomework::type eq 'exam') {
- my $partid=$Apache::inputtags::part;
- my $id=$Apache::inputtags::response[-1];
my $number_of_bubbles = &Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.numbubbles');
if ($Apache::inputtags::params{'numbubbles'}) {
$number_of_bubbles = $Apache::inputtags::params{'numbubbles'};
@@ -302,8 +417,7 @@ sub end_numericalresponse {
} elsif ($target eq 'edit') {
$result.=''.&Apache::edit::end_table;
} elsif ($target eq 'answer' || $target eq 'analyze') {
-
- my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]";
+ my $part_id="$partid.$id";
if ($target eq 'analyze') {
push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id);
$Apache::lonhomework::analyze{"$part_id.type"} = $tag;
@@ -324,6 +438,7 @@ sub end_numericalresponse {
if ($target eq 'answer') {
$result.=&Apache::response::answer_header($tag);
}
+ my ($sigline,$tolline);
for(my $i=0;$i<=$#answers;$i++) {
my $ans=$answers[$i];
my $fmt=$formats[0];
@@ -347,12 +462,16 @@ sub end_numericalresponse {
#}
}
if ($target eq 'answer') {
- if ($high && $tag eq 'numericalresponse') { $ans.=' ['.$low.','.$high.']'; }
+ 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);
@@ -367,6 +486,56 @@ sub end_numericalresponse {
}
}
}
+
+ 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);
+ }
+ }
+ 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') {
@@ -635,7 +804,7 @@ sub end_stringresponse {
# $answer=$token->[2]->{'answer'};
# }
${$safeeval->varglob('LONCAPA::response')}=$response;
- $result = &Apache::run::run('return $LONCAPA::response=~m'.$answer,$safeeval);
+ $result = &Apache::run::run('if ($LONCAPA::response=~m'.$answer.') { return 1; } else { return 0; }',$safeeval);
&Apache::lonxml::debug("current $response");
&Apache::lonxml::debug("current $answer");
$ad = ($result) ? 'APPROX_ANS' : 'INCORRECT';
@@ -696,6 +865,10 @@ sub end_stringresponse {
# foreach my $ans (@answers) {
if ($target eq 'answer') {
$result.=&Apache::response::answer_part('stringresponse',$answer);
+ if ($type eq 're') {
+ $result.=&Apache::response::answer_part('stringresponse',
+ $answerdisplay);
+ }
} elsif ($target eq 'analyze') {
push (@{ $Apache::lonhomework::analyze{"$part.$id.answer"} },
$answer);
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.