--- loncom/homework/caparesponse/caparesponse.pm 2008/09/04 13:49:19 1.228
+++ loncom/homework/caparesponse/caparesponse.pm 2011/01/25 04:30:13 1.244
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# caparesponse definition
#
-# $Id: caparesponse.pm,v 1.228 2008/09/04 13:49:19 riegler Exp $
+# $Id: caparesponse.pm,v 1.244 2011/01/25 04:30:13 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,6 +33,7 @@ use Safe::Hole;
use Apache::lonmaxima();
use Apache::lonlocal;
use Apache::lonnet;
+use Apache::lonmsg();
use Apache::response();
use Storable qw(dclone);
@@ -305,14 +306,11 @@ sub start_numericalresponse {
my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffunit');
&Apache::lonxml::debug("Got unit $hideunit for $partid $id");
#no way to enter units, with radio buttons
- if (lc($hideunit) eq "yes") {
+ if ((lc($hideunit) eq "yes") && ($Apache::lonhomework::type ne 'exam')) {
my $unit=&Apache::lonxml::get_param_var('unit',$parstack,
$safeeval);
if ($unit =~ /\S/) { $result.=" (in $unit) "; }
}
- if (($token->[1] eq 'formularesponse') &&
- ($Apache::inputtags::status['-1'] eq 'CAN_ANSWER')) {
- }
if ( &Apache::response::show_answer() ) {
&set_answertext($tag_internal_answer_name,$target,$token,$tagstack,
$parstack,$parser,$safeeval,-1);
@@ -430,8 +428,12 @@ sub check_submission {
}
} elsif ($tag eq 'numericalresponse') {
$$args_ref{'type'}='float';
+ } elsif ($tag eq 'stringresponse') {
+ if ($$args_ref{'type'} eq '') {
+ $$args_ref{'type'} = 'ci';
+ }
}
-
+
&add_in_tag_answer($parstack,$safeeval);
if (!%answer) {
@@ -449,6 +451,7 @@ sub check_submission {
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);
@@ -464,6 +467,48 @@ sub check_submission {
return($ad,$msg, $name);
}
+sub stringresponse_gradechange {
+ my ($part,$id,$previous,$caller,$response,$ad,$type) = @_;
+ return unless (ref($previous) eq 'HASH');
+ my ($prevarray,$prevaward);
+ my %typenames = (
+ cs => 'Case sensitive',
+ ci => 'Case insensitive',
+ );
+ if ($caller eq 'cs') {
+ return unless (ref($previous->{'version'}) eq 'ARRAY');
+ $prevarray = $previous->{'version'};
+ $prevaward = $previous->{'award'};
+ } elsif ($caller eq 'ci') {
+ return unless (ref($previous->{'versionci'}) eq 'ARRAY');
+ $prevarray = $previous->{'versionci'};
+ $prevaward = $previous->{'awardci'};
+ } else {
+ return;
+ }
+ my $count=0;
+ my %count_lookup;
+ foreach my $i (1..$Apache::lonhomework::history{'version'}) {
+ my $prefix = $i.":resource.$part";
+ next if (!exists($Apache::lonhomework::history{"$prefix.award"}));
+ $count++;
+ $count_lookup{$i} = $count;
+ }
+ my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
+ my %coursedesc = &Apache::lonnet::coursedescription($courseid);
+ my $cdom = $coursedesc{'domain'};
+ my $versions = ' (submissions: '.join(', ',map {$count_lookup{$_} } @{$prevarray}).')';
+ my $warning = "String Response ($typenames{$type}) grading discrepancy: award for response of $response changed from $prevaward".$versions." to $ad; user: $name:$domain in course: $courseid for part: $part response: $id for symb: $symb";
+ &Apache::lonnet::logthis($warning);
+ my $origmail = $Apache::lonnet::perlvar{'lonAdmEMail'};
+ my $recipients = &Apache::loncommon::build_recipient_list(undef,'errormail',
+ $cdom,$origmail);
+ if ($recipients ne '') {
+ &Apache::lonmsg::sendemail($recipients,'Stringresponse Grading Discrepancy',$warning);
+ }
+ return;
+}
+
sub add_in_tag_answer {
my ($parstack,$safeeval,$response_level) = @_;
my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval,
@@ -532,11 +577,18 @@ sub end_numericalresponse {
$Apache::inputtags::params{'sig'});
}
&Apache::lonxml::debug("\n
result:$result:$Apache::lonxml::curdepth
\n");
- if ($Apache::lonhomework::type eq 'survey' &&
- ($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' ||
- $ad eq 'EXACT_ANS')) {
- $ad='SUBMITTED';
- }
+ if (($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' ||
+ $ad eq 'EXACT_ANS')) {
+ if ($Apache::lonhomework::type eq 'survey') {
+ $ad='SUBMITTED';
+ } elsif ($Apache::lonhomework::type eq 'surveycred') {
+ $ad='SUBMITTED_CREDIT';
+ } elsif ($Apache::lonhomework::type eq 'anonsurvey') {
+ $ad='ANONYMOUS';
+ } elsif ($Apache::lonhomework::type eq 'anonsurveycred') {
+ $ad='ANONYMOUS_CREDIT';
+ }
+ }
&Apache::response::handle_previous(\%previous,$ad);
$Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}=$ad;
$Apache::lonhomework::results{"resource.$partid.$id.awardmsg"}=$msg;
@@ -584,9 +636,16 @@ sub end_numericalresponse {
&get_table_sizes($number_of_bubbles,$bubble_display);
my $j=0;
my $cou=0;
- $result.='\vskip -1 mm \noindent \begin{enumerate}\item[\textbf{'.$Apache::lonxml::counter.'}.]';
+ $result.='\vskip 2mm \noindent ';
+ $result .= '\textbf{'.$Apache::lonxml::counter.'.} \vskip -3mm ';
+
for (my $i=0;$i<$number_of_tables;$i++) {
- $result.='\vskip -1 mm \noindent \setlength{\tabcolsep}{2 mm}\begin{tabular}{';
+ if ($i == 0) {
+ $result .= '\vskip -1mm ';
+ } else {
+ $result .= '\vskip 1mm ';
+ }
+ $result.='\noindent \setlength{\tabcolsep}{2 mm}\hskip 2pc\begin{tabular}{';
for (my $ind=0;$ind<$table_range[$j];$ind++) {
$result.='p{3 mm}p{'.$celllength.' mm}';
}
@@ -599,15 +658,15 @@ sub end_numericalresponse {
$j++;
$result.='\\\\\end{tabular}\vskip 0 mm ';
}
- $result.='\end{enumerate}';
} else {
$increment = &Apache::response::repetition();
}
}
}
if (($target eq 'web') && ($tag eq 'formularesponse')
- && ($Apache::lonhomework::type ne 'exam')) {
- $result.=&Apache::response::edit_mathresponse_button($id,"HWVAL_$id");
+ && ($Apache::lonhomework::type ne 'exam') && ($Apache::inputtags::status['-1'] eq 'CAN_ANSWER')
+ && (&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffeditor') ne 'yes')) {
+ $result.=&Apache::response::edit_mathresponse_button($id,"HWVAL_$id");
}
&Apache::response::setup_prior_tries_hash(\&format_prior_response_numerical);
@@ -750,16 +809,17 @@ sub end_numericalresponse {
if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
my $error;
if ($tag eq 'formularesponse') {
- $error=&mt('Computer\'s answer is incorrect ("[_1]").',join(', ',@$response));
+ $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);
+ $error=&mt("Computer's answer is incorrect ([_1]).",'"'.join(', ',@$response).'"').' ';
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.',join(', ',@$response),$tolline,$sigline);
+ $error.=&mt('It is likely that the tolerance range [_1] or significant figures [_2] need to be adjusted.',$tolline,$sigline);
} else {
- $error=&mt('Computer\'s answer is incorrect ("[_1]"). It is likely that the tolerance range [_2] needs to be adjusted.',join(', ',@$response),$tolline);
+ $error.=&mt('It is likely that the tolerance range [_1] needs to be adjusted.',$tolline);
}
}
if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
@@ -1137,7 +1197,8 @@ sub end_stringresponse {
my $response = &Apache::response::getresponse();
if ( $response =~ /[^\s]/) {
my %previous = &Apache::response::check_for_previous($response,
- $part,$id);
+ $part,$id,
+ undef,$type);
&Apache::lonxml::debug("submitted a $response
\n");
&Apache::lonxml::debug($$parstack[-1] . "\n
");
$Apache::lonhomework::results{"resource.$part.$id.submission"}=
@@ -1159,13 +1220,42 @@ sub end_stringresponse {
my @args = ('type');
my $args_ref = &setup_capa_args($safeeval,$parstack,
\@args,$response);
-
+ if ($$args_ref{'type'} eq '') {
+ $$args_ref{'type'} = 'ci';
+ }
&add_in_tag_answer($parstack,$safeeval);
- my (@final_awards,@final_msgs,@names);
+ my (@final_awards,@final_msgs,@names,%ansstring);
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);
+ if ($$args_ref{'type'} =~ /^c[si]$/) {
+ $ansstring{$name} = pop(@msgs);
+ }
+ if ($$args_ref{'type'} =~ /^c[si]$/) {
+ my $control_chars_removed = pop(@msgs);
+ my $error = pop(@msgs);
+ if (($error ne '') ||
+ ($control_chars_removed ne '')) {
+ my ($symb,$courseid,$sdomain,$sname) =
+ &Apache::lonnet::whichuser();
+ if ($control_chars_removed ne '') {
+ my $showresponse = $response;
+ if ($response =~ /[\000-\037]/) {
+ $response =~ s/[\000-\037]//g;
+ }
+ if ($showresponse =~ /[\r\n\f]/) {
+ my @lines = split(/[\r\n\f]+/,$showresponse);
+ $showresponse = join('\\n',@lines);
+ }
+ &Apache::lonnet::logthis("Stringresponse grading: control characters stripped from submission ".$showresponse." for $sname:$sdomain in $courseid for part: $part response: $id and symb: $symb");
+ $Apache::lonhomework::results{"resource.$part.$id.submission"} = $response;
+ }
+ if ($error ne '') {
+ &Apache::lonnet::logthis("Stringresponse grading error: $error for $sname:$sdomain in $courseid for part: $part response: $id and symb: $symb");
+ }
+ }
+ }
&Apache::lonxml::debug('msgs are'.join(':',@msgs));
my ($awards)=split(/:/,$result);
my (@awards) = split(/,/,$awards);
@@ -1176,16 +1266,50 @@ sub end_stringresponse {
push(@names,$name);
&Apache::lonxml::debug("\n
result:$result:$Apache::lonxml::curdepth
\n");
}
- my ($ad, $msg, $name) =
+ ($ad, $msg, my $name) =
&Apache::inputtags::finalizeawards(\@final_awards,
\@final_msgs,
\@names,1);
+ if (keys(%ansstring) > 0) {
+ $Apache::lonhomework::results{"resource.$part.$id.answerstring"} = &Apache::lonnet::hash2str(%ansstring);
+ }
}
- if ($Apache::lonhomework::type eq 'survey' &&
- ($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' ||
- $ad eq 'EXACT_ANS')) {
- $ad='SUBMITTED';
- }
+ if (($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' ||
+ $ad eq 'EXACT_ANS')) {
+ if ($Apache::lonhomework::type eq 'survey') {
+ $ad='SUBMITTED';
+ } elsif ($Apache::lonhomework::type eq 'surveycred') {
+ $ad='SUBMITTED_CREDIT';
+ } elsif ($Apache::lonhomework::type eq 'anonsurvey') {
+ $ad='ANONYMOUS';
+ } elsif ($Apache::lonhomework::type eq 'anonsurveycred') {
+ $ad='ANONYMOUS_CREDIT';
+ }
+ }
+ unless (($env{'request.state'} eq 'construct') ||
+ ($Apache::lonhomework::type eq 'randomizetry')) {
+ if (($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' || $ad eq 'EXACT_ANS')) {
+ if ($previous{'used'}) {
+ if ($ad ne $previous{'award'}) {
+ if (($previous{'award'} eq 'INCORRECT' ||
+ $previous{'award'} eq 'APPROX_ANS' ||
+ $previous{'award'} eq 'EXACT_ANS')) {
+ &stringresponse_gradechange($part,$id,\%previous,
+ 'cs',$response,$ad,$type);
+ }
+ }
+ } elsif ($previous{'usedci'}) {
+ if ($ad ne $previous{'awardci'}) {
+ if (($previous{'awardci'} eq 'INCORRECT' ||
+ $previous{'awardci'} eq 'APPROX_ANS' ||
+ $previous{'awardci'} eq 'EXACT_ANS')) {
+ &stringresponse_gradechange($part,$id,\%previous,
+ 'ci',$response,$ad,$type);
+ }
+ }
+ }
+ }
+ }
&Apache::response::handle_previous(\%previous,$ad);
$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$ad;
$Apache::lonhomework::results{"resource.$part.$id.awardmsg"}=$msg;
@@ -1211,6 +1335,9 @@ sub end_stringresponse {
if ($target eq 'answer') {
$result.=&Apache::response::answer_part('stringresponse',
$element);
+ if ($env{'form.grade_retrieveanswers'}) {
+ $env{'form.grade_answers.resource.'.$part.'.'.$id} = $element;
+ }
} elsif ($target eq 'analyze') {
push (@{ $Apache::lonhomework::analyze{"$part.$id.answer"}{$name}[$i] },
$element);