loncom/homework/response.pm - diff

Return to response.pm CVS log

Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/response.pm between versions 1.188 and 1.246

version 1.188, 2008/03/06 16:28:20	version 1.246, 2018/06/06 18:39:55
Line 26	Line 26
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#

	=pod

	=head1 NAME

	Apache::response.pm

	=head1 SYNOPSIS

	This is part of the LearningOnline Network with CAPA project
	described at http://www.lon-capa.org.


	=head1 NOTABLE SUBROUTINES

	=over

	=item

	=back

	=cut


package Apache::response;	package Apache::response;
use strict;	use strict;
use Apache::lonlocal;	use Apache::lonlocal;
use Apache::lonnet;	use Apache::lonnet;
	use Apache::inputtags();
use Apache::lonmaxima();	use Apache::lonmaxima();
	use Apache::lonr();
	use Apache::lontexconvert();

BEGIN {	BEGIN {
&Apache::lonxml::register('Apache::response',('responseparam','parameter','dataresponse','customresponse','mathresponse'));	&Apache::lonxml::register('Apache::response',('responseparam','parameter','dataresponse','customresponse','mathresponse'));
Line 112 sub poprandomnumber {	Line 138 sub poprandomnumber {
}	}

sub setrandomnumber {	sub setrandomnumber {
my ($ignore_id2) = @_;	my ($ignore_id2,$target,$rndseed) = @_;
my $rndseed;	if (!defined($rndseed)) {
$rndseed=&Apache::structuretags::setup_rndseed();	$rndseed=&Apache::structuretags::setup_rndseed(undef,$target);
	}
if (!defined($rndseed)) { $rndseed=&Apache::lonnet::rndseed(); }	if (!defined($rndseed)) { $rndseed=&Apache::lonnet::rndseed(); }
&Apache::lonxml::debug("randseed $rndseed");	&Apache::lonxml::debug("randseed $rndseed");
# $rndseed=unpack("%32i",$rndseed);	# $rndseed=unpack("%32i",$rndseed);
Line 154 sub setrandomnumber {	Line 181 sub setrandomnumber {
} else {	} else {
($rndmod,$rndmod2)=&Apache::lonnet::digest("$id1,$id2");	($rndmod,$rndmod2)=&Apache::lonnet::digest("$id1,$id2");
}	}

if ($rndseed =~/([,:])/) {	if ($rndseed =~/([,:])/) {
my $char=$1;	my $char=$1;
use integer;	use integer;
Line 216 sub meta_stores_write {	Line 242 sub meta_stores_write {
"></stores>\n";	"></stores>\n";
}	}

	=pod

	=item mandatory_part_meta()

	Autogenerate metadata for mandatory
	input (from RAT or lonparmset) and
	output (to lonspreadsheet)
	of each part

	Note: responseid-specific data 'submission' and 'awarddetail'
	not available to spreadsheet -> skip here

	=cut


sub mandatory_part_meta {	sub mandatory_part_meta {
#	return &meta_package_write('part').
# Autogenerate metadata for mandatory	&meta_stores_write('solved','string','Problem Status').
# input (from RAT or lonparmset) and	&meta_stores_write('tries','int_zeropos','Number of Attempts').
# output (to lonspreadsheet)	&meta_stores_write('awarded','float','Partial Credit Factor');
# of each part
#
return
# &meta_parameter_write('opendate','date_start','',
# 'Opening Date').
# &meta_parameter_write('duedate','date_end','',
# 'Due Date').
# &meta_parameter_write('answerdate','date_start','',
# 'Show Answer Date').
# &meta_parameter_write('weight','int_zeropos','',
# 'Available Points').
# &meta_parameter_write('maxtries','int_pos','',
# 'Maximum Number of Tries').
&meta_package_write('part').
&meta_stores_write('solved','string',
'Problem Status').
&meta_stores_write('tries','int_zeropos',
'Number of Attempts').
&meta_stores_write('awarded','float',
'Partial Credit Factor');
#
# Note: responseid-specific data 'submission' and 'awarddetail'
# not available to spreadsheet -> skip here
#
}	}

sub meta_part_order {	sub meta_part_order {
	my ($type) = @_;
if (@Apache::inputtags::partlist) {	if (@Apache::inputtags::partlist) {
my @parts=@Apache::inputtags::partlist;	my @parts=@Apache::inputtags::partlist;
shift(@parts);	unless ($type eq 'library') {
	shift(@parts);
	}
return '<partorder>'.join(',',@parts).'</partorder>'."\n";	return '<partorder>'.join(',',@parts).'</partorder>'."\n";
	} elsif ($type eq 'library') {
	return '<partorder></partorder>'."\n";
} else {	} else {
return '<partorder>0</partorder>'."\n";	return '<partorder>0</partorder>'."\n";
}	}
Line 265 sub meta_response_order {	Line 287 sub meta_response_order {
}	}

sub check_for_previous {	sub check_for_previous {
my ($curresponse,$partid,$id,$last) = @_;	my ($curresponse,$partid,$id,$last,$type) = @_;
my %previous;	my %previous;
$previous{'used'} = 0;	$previous{'used'} = 0;
	my $questiontype = $Apache::lonhomework::type;
	my $curr_rndseed = $env{'form.'.$partid.'.rndseed'};
foreach my $key (sort(keys(%Apache::lonhomework::history))) {	foreach my $key (sort(keys(%Apache::lonhomework::history))) {
if ($key =~ /resource\.$partid\.$id\.submission$/) {	if ($key =~ /resource\.\Q$partid\E\.\Q$id\E\.submission$/) {
if ( $last && $key =~ /^(\d+):/ ) {	if ( $last && $key =~ /^(\d+):/ ) {
next if ($1 >= $last);	next if ($1 >= $last);
}	}
&Apache::lonxml::debug("Trying $key");	&Apache::lonxml::debug("Trying $key");
my $pastresponse=$Apache::lonhomework::history{$key};	my $pastresponse=$Apache::lonhomework::history{$key};
if ($pastresponse eq $curresponse) {	if ($pastresponse eq $curresponse) {
$previous{'used'} = 1;
my $history;	my $history;
if ( $key =~ /^(\d+):/ ) {	if ( $key =~ /^(\d+):/ ) {
$history=$1;	$history=$1;
	next if ((($questiontype eq 'randomizetry') \|\|
	($Apache::lonhomework::history{"$history:resource.$partid.type"} eq 'randomizetry')) &&
	($curr_rndseed ne $Apache::lonhomework::history{"$history:resource.$partid.rndseed"}));
$previous{'award'} = $Apache::lonhomework::history{"$history:resource.$partid.$id.awarddetail"};	$previous{'award'} = $Apache::lonhomework::history{"$history:resource.$partid.$id.awarddetail"};
$previous{'last'}='0';	$previous{'last'}='0';
push(@{ $previous{'version'} },$history);	push(@{ $previous{'version'} },$history);
} else {	} else {
	next if ((($questiontype eq 'randomizetry') \|\|
	($Apache::lonhomework::history{"resource.$partid.type"} eq 'randomizetry')) &&
	($curr_rndseed ne $Apache::lonhomework::history{"resource.$partid.rndseed"}));
$previous{'award'} = $Apache::lonhomework::history{"resource.$partid.$id.awarddetail"};	$previous{'award'} = $Apache::lonhomework::history{"resource.$partid.$id.awarddetail"};
$previous{'last'}='1';	$previous{'last'}='1';
}	}
	$previous{'used'} = 1;
if (! $previous{'award'} ) { $previous{'award'} = 'UNKNOWN'; }	if (! $previous{'award'} ) { $previous{'award'} = 'UNKNOWN'; }
	if ($previous{'award'} eq 'INTERNAL_ERROR') { $previous{'used'}=0; }
&Apache::lonxml::debug("got a match :$previous{'award'}:$previous{'used'}:");	&Apache::lonxml::debug("got a match :$previous{'award'}:$previous{'used'}:");
}	} elsif ($type eq 'ci') {
	if (lc($pastresponse) eq lc($curresponse)) {
	if ($key =~ /^(\d+):/) {
	my $history = $1;
	next if (($questiontype eq 'randomizetry') &&
	($curr_rndseed ne $Apache::lonhomework::history{"$history:resource.$partid.rndseed"}));
	push (@{$previous{'versionci'}},$history);
	$previous{'awardci'} = $Apache::lonhomework::history{"$history:resource.$partid.$id.awarddetail"};
	$previous{'usedci'} = 1;
	}
	}
	}
}	}
}	}
&Apache::lonhomework::showhash(%previous);	&Apache::lonhomework::showhash(%previous);
Line 302 sub handle_previous {	Line 344 sub handle_previous {
if ($$previous{'last'}) {	if ($$previous{'last'}) {
push(@Apache::inputtags::previous,'PREVIOUSLY_LAST');	push(@Apache::inputtags::previous,'PREVIOUSLY_LAST');
push(@Apache::inputtags::previous_version,$$previous{'version'});	push(@Apache::inputtags::previous_version,$$previous{'version'});
} elsif ($Apache::lonhomework::type ne 'survey') {	} elsif (($Apache::lonhomework::type ne 'survey') &&
	($Apache::lonhomework::type ne 'surveycred') &&
	($Apache::lonhomework::type ne 'anonsurvey') &&
	($Apache::lonhomework::type ne 'anonsurveycred')) {
push(@Apache::inputtags::previous,'PREVIOUSLY_USED');	push(@Apache::inputtags::previous,'PREVIOUSLY_USED');
push(@Apache::inputtags::previous_version,$$previous{'version'});	push(@Apache::inputtags::previous_version,$$previous{'version'});
}	}
Line 358 sub end_dataresponse {	Line 403 sub end_dataresponse {
$Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}='SUBMITTED';	$Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}='SUBMITTED';
}	}
} else {	} else {
$result='Not Permitted to change values.'	$result=&mt('Not Permitted to change values');
}	}
}	}
}	}
Line 383 sub start_customresponse {	Line 428 sub start_customresponse {
} elsif ($target eq 'edit') {	} elsif ($target eq 'edit') {
$result.=&Apache::edit::tag_start($target,$token);	$result.=&Apache::edit::tag_start($target,$token);
$result.=&Apache::edit::text_arg('String to display for answer:',	$result.=&Apache::edit::text_arg('String to display for answer:',
'answerdisplay',$token);	'answerdisplay',$token,'50');
$result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row();	$result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row();
} elsif ($target eq 'modified') {	} elsif ($target eq 'modified') {
my $constructtag;	my $constructtag;
Line 423 sub end_customresponse {	Line 468 sub end_customresponse {
${$safeeval->varglob('LONCAPA::customresponse_submission')}=	${$safeeval->varglob('LONCAPA::customresponse_submission')}=
$response;	$response;

my $award = &Apache::run::run('{ my $submission=$LONCAPA::customresponse_submission;'.$Apache::response::custom_answer[-1].'}',$safeeval);	my ($award,$score) = &Apache::run::run('{ my $submission=$LONCAPA::customresponse_submission;'.$Apache::response::custom_answer[-1].'}',$safeeval);
if (!&Apache::inputtags::valid_award($award)) {	if (!&Apache::inputtags::valid_award($award)) {
$error = $award;	$error = $award;
$award = 'ERROR';	$award = 'ERROR';
}	}
	if (($award eq 'INCORRECT' \|\| $award eq 'APPROX_ANS' \|\|
	$award eq 'EXACT_ANS')) {
	if ($Apache::lonhomework::type eq 'survey') {
	$award='SUBMITTED';
	} elsif ($Apache::lonhomework::type eq 'surveycred') {
	$award='SUBMITTED_CREDIT';
	} elsif ($Apache::lonhomework::type eq 'anonsurvey') {
	$award='ANONYMOUS';
	} elsif ($Apache::lonhomework::type eq 'anonsurveycred') {
	$award='ANONYMOUS_CREDIT';
	}
	}
&Apache::response::handle_previous(\%previous,$award);	&Apache::response::handle_previous(\%previous,$award);
$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=	$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=
$award;	$award;
	if ($award eq 'ASSIGNED_SCORE') {
	$Apache::lonhomework::results{"resource.$part.$id.awarded"}=1.0*$score;
	}
if ($error) {	if ($error) {
$Apache::lonhomework::results{"resource.$part.$id.awardmsg"}=	$Apache::lonhomework::results{"resource.$part.$id.awardmsg"}=
$error;	$error;
Line 447 sub end_customresponse {	Line 507 sub end_customresponse {
$result .= &Apache::response::answer_footer('customresponse');	$result .= &Apache::response::answer_footer('customresponse');
}	}
if ($target eq 'web') {	if ($target eq 'web') {
&setup_prior_tries_hash(\&format_prior_response_math);	&setup_prior_tries_hash(\&format_prior_response_custom);
}	}
if ($target eq 'grade' \|\| $target eq 'web' \|\| $target eq 'answer' \|\|	if ($target eq 'grade' \|\| $target eq 'web' \|\| $target eq 'answer' \|\|
$target eq 'tex' \|\| $target eq 'analyze') {	$target eq 'tex' \|\| $target eq 'analyze') {
&Apache::lonxml::increment_counter(&Apache::response::repetition(),	my $repetition = &repetition();
"$part.$id");	&Apache::lonxml::increment_counter($repetition,"$part.$id");
if ($target eq 'analyze') {	if ($target eq 'analyze') {
$Apache::lonhomework::analyze{"$part.$id.type"} = 'customresponse';	$Apache::lonhomework::analyze{"$part.$id.type"} = 'customresponse';
&Apache::lonhomework::set_bubble_lines();	&Apache::lonhomework::set_bubble_lines();
}	}
}	}
	if ($target eq 'web') {
	&setup_prior_tries_hash(\&format_prior_response_math);
	}
pop(@Apache::lonxml::namespace);	pop(@Apache::lonxml::namespace);
pop(@Apache::response::custom_answer);	pop(@Apache::response::custom_answer);
pop(@Apache::response::custom_answer_type);	pop(@Apache::response::custom_answer_type);
Line 468 sub end_customresponse {	Line 531 sub end_customresponse {

sub format_prior_response_custom {	sub format_prior_response_custom {
my ($mode,$answer) =@_;	my ($mode,$answer) =@_;
	if (ref($answer) eq 'ARRAY') {
	$answer = '('.join(', ', @{ $answer }).')';
	}
return '<span class="LC_prior_custom">'.	return '<span class="LC_prior_custom">'.
&HTML::Entities::encode($answer,'"<>&').'</span>';	&HTML::Entities::encode($answer,'"<>&').'</span>';
}	}
Line 486 sub start_mathresponse {	Line 552 sub start_mathresponse {
$safeeval);	$safeeval);
$Apache::inputtags::answertxt{$id}=[$answer];	$Apache::inputtags::answertxt{$id}=[$answer];
}	}

} elsif ($target eq 'edit') {	} elsif ($target eq 'edit') {
$result.=&Apache::edit::tag_start($target,$token);	$result.=&Apache::edit::tag_start($target,$token);
$result.=&Apache::edit::text_arg('String to display for answer:',	$result.=&Apache::edit::text_arg('String to display for answer:',
'answerdisplay',$token);	'answerdisplay',$token,'50');
$result.=&Apache::edit::select_arg('Algebra System:',	$result.=&Apache::edit::select_arg('Algebra System:',
'cas',	'cas',
['maxima'],	['maxima','R'],
$token);	$token);
$result.=&Apache::edit::text_arg('Argument Array:',	$result.=&Apache::edit::text_arg('Argument Array:',
'args',$token);	'args',$token).
	&Apache::loncommon::help_open_topic('Maxima_Argument_Array');
	$result.=&Apache::edit::text_arg('Libraries:',
	'libraries',$token).
	&Apache::loncommon::help_open_topic('Maxima_Libraries');
$result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row();	$result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row();
} elsif ($target eq 'modified') {	} elsif ($target eq 'modified') {
my $constructtag;	my $constructtag;
$constructtag=&Apache::edit::get_new_args($token,$parstack,	$constructtag=&Apache::edit::get_new_args($token,$parstack,
$safeeval,'answerdisplay','cas','args');	$safeeval,'answerdisplay','cas','args','libraries');
if ($constructtag) {	if ($constructtag) {
$result = &Apache::edit::rebuild_tag($token);	$result = &Apache::edit::rebuild_tag($token);
}	}
Line 532 sub end_mathresponse {	Line 603 sub end_mathresponse {
my $cas = &Apache::lonxml::get_param('cas',$parstack,$safeeval);	my $cas = &Apache::lonxml::get_param('cas',$parstack,$safeeval);
if ($cas eq 'maxima') {	if ($cas eq 'maxima') {
my $args = [&Apache::lonxml::get_param_var('args',$parstack,$safeeval)];	my $args = [&Apache::lonxml::get_param_var('args',$parstack,$safeeval)];
$award=&Apache::lonmaxima::maxima_run($Apache::response::custom_answer[-1],$response,$args);	$award=&Apache::lonmaxima::maxima_run($Apache::response::custom_answer[-1],$response,$args,
	&Apache::lonxml::get_param('libraries',$parstack,$safeeval));
	}
	if ($cas eq 'R') {
	my $args = [&Apache::lonxml::get_param_var('args',$parstack,$safeeval)];
	$award=&Apache::lonr::r_run($Apache::response::custom_answer[-1],$response,$args,
	&Apache::lonxml::get_param('libraries',$parstack,$safeeval));
}	}

if (!&Apache::inputtags::valid_award($award)) {	if (!&Apache::inputtags::valid_award($award)) {
$error = $award;	$error = $award;
$award = 'ERROR';	$award = 'ERROR';
}	}
	if (($award eq 'INCORRECT' \|\| $award eq 'APPROX_ANS' \|\|
	$award eq 'EXACT_ANS')) {
	if ($Apache::lonhomework::type eq 'survey') {
	$award='SUBMITTED';
	} elsif ($Apache::lonhomework::type eq 'surveycred') {
	$award='SUBMITTED_CREDIT';
	} elsif ($Apache::lonhomework::type eq 'anonsurvey') {
	$award='ANONYMOUS';
	} elsif ($Apache::lonhomework::type eq 'anonsurveycred') {
	$award='ANONYMOUS_CREDIT';
	}
	}
&Apache::response::handle_previous(\%previous,$award);	&Apache::response::handle_previous(\%previous,$award);
$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=	$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=
$award;	$award;
Line 547 sub end_mathresponse {	Line 637 sub end_mathresponse {
}	}
}	}
}	}
if ($target eq 'web') {
&setup_prior_tries_hash(\&format_prior_response_math);
}

pop(@Apache::lonxml::namespace);	pop(@Apache::lonxml::namespace);
pop(@Apache::response::custom_answer);	pop(@Apache::response::custom_answer);
Line 651 sub start_responseparam {	Line 738 sub start_responseparam {
}	}
}	}
if (defined($optionlist)) {	if (defined($optionlist)) {
$result.='Use template: <select name="'.	$result.=&mt('Use template:').' <select name="'.
&Apache::edit::html_element_name('parameter_package').'">'.	&Apache::edit::html_element_name('parameter_package').'">'.
'<option value=""></option>'.$optionlist.'</select><br />';	'<option value=""></option>'.$optionlist.'</select><br />';
}	}
Line 757 sub answer_header {	Line 844 sub answer_header {
if ($Apache::lonhomework::type eq 'exam') {	if ($Apache::lonhomework::type eq 'exam') {
$bit = ($Apache::lonxml::counter+$increment).') ';	$bit = ($Apache::lonxml::counter+$increment).') ';
} else {	} else {
$bit .= ' Answer for Part: \verb\|'.	$bit .= ' '.&mt('Answer for Part: [_1]',
$Apache::inputtags::part.'\| ';	'\verb\|'.$Apache::inputtags::part.'\|').' ';
}	}
push(@answer_bits,$bit);	push(@answer_bits,$bit);
} else {	} else {
Line 790 sub next_answer {	Line 877 sub next_answer {

sub answer_part {	sub answer_part {
my ($type,$answer,$args) = @_;	my ($type,$answer,$args) = @_;
&Apache::lonxml::debug("In answerpart :$type:$answer:$args:");

my $result;	my $result;
if ($env{'form.answer_output_mode'} eq 'tex') {	if ($env{'form.answer_output_mode'} eq 'tex') {
if (!$args->{'no_verbatim'}) {	if (!$args->{'no_verbatim'}) {
Line 803 sub answer_part {	Line 888 sub answer_part {
last;	last;
}	}
}	}
my $answerelements=$answer;	my $fullanswer=$answer;
$answer='';	$answer='';
foreach my $element (split(/[\;\:]/,$answerelements)) {	foreach my $element (split(/[\;]/,$fullanswer)) {
if ($element ne '') {	if ($element ne '') {
$answer.= '\noindent\verb'.$to_use.$element.$to_use.'\newline';	$answer.= '\verb'.$to_use.$element.$to_use.' \newline';
}	}
}	}
}	}
if ($answer ne '') {	if ($answer ne '') {
Line 819 sub answer_part {	Line 904 sub answer_part {
$result .= '<tr>';	$result .= '<tr>';
$need_row_start = 0;	$need_row_start = 0;
}	}
$answer=~s/\; /\<\/nobr\>\<br \/\>\<nobr\>/gs;	$result .= '<td>'.$answer.'</td>';
$result .= '<td><nobr>'.$answer.'</nobr></td>';
}	}
return $result;	return $result;
}	}
Line 829 sub answer_footer {	Line 913 sub answer_footer {
my ($type) = @_;	my ($type) = @_;
my $result;	my $result;
if ($env{'form.answer_output_mode'} eq 'tex') {	if ($env{'form.answer_output_mode'} eq 'tex') {
my $columns = scalar(@answer_bits)-1;	$result = ' \vskip 0 mm \noindent \begin{tabular}{\|p{1.5cm}\|p{6.8cm}\|}\hline ';
$result = ' \vskip 0 mm \noindent \begin{tabular}{\|p{1.5cm}\|'.'p{3cm}\|'x$columns.'}\hline ';	$result .= $answer_bits[0].'&\vspace*{-4mm}\begin{itemize}';
$result .= join(' & ',@answer_bits);	for (my $i=1;$i<=$#answer_bits;$i++) {
$result .= ' \\\\ \\hline \end{tabular} \vskip 0 mm ';	$result.='\item '.$answer_bits[$i].'\vspace*{-7mm}';
	}
	$result .= ' \end{itemize} \\\\ \hline \end{tabular} \vskip 0 mm ';
} else {	} else {
if (!$need_row_start) {	if (!$need_row_start) {
$result .= '</tr>';	$result .= '</tr>';
Line 854 sub showallfoils {	Line 940 sub showallfoils {
}	}
}	}
if ($Apache::lonhomework::type eq 'survey') { return 1; }	if ($Apache::lonhomework::type eq 'survey') { return 1; }
	if ($Apache::lonhomework::type eq 'surveycred') { return 1; }
	if ($Apache::lonhomework::type eq 'anonsurvey') { return 1; }
	if ($Apache::lonhomework::type eq 'anonsurveycred') { return 1; }

return 0;	return 0;
}	}

=pod	=pod

=item &getresponse($offset,$resulttype);	=item &getresponse();

Retreives the current submitted response, helps out in the case of	Retreives the current submitted response, helps out in the case of
scantron mode.	scantron mode.
Line 905 sub getresponse {	Line 995 sub getresponse {
my $id = $Apache::inputtags::response[-1];	my $id = $Apache::inputtags::response[-1];

my $line;	my $line;
	my $startline = $env{'form.scantron_questnum_start.'.$part.'.'.$id};
	if (!$startline) {
	$startline = $Apache::lonxml::counter;
	}
for ($line = 0; $line < $lines; $line++) {	for ($line = 0; $line < $lines; $line++) {
my $theline = $Apache::lonxml::counter+$offset-1+$line;	my $theline = $startline+$offset-1+$line;
$response = $env{"scantron.$theline.answer"};	$response = $env{"scantron.$theline.answer"};
if ((defined($response)) && ($response ne "") && ($response ne " ")) {	if ((defined($response)) && ($response ne "") && ($response ne " ")) {
last;	last;
}	}

}	}

# save bubbled letter for later	# save bubbled letter for later
$Apache::lonhomework::results{"resource.$part.$id.scantron"}.=	$Apache::lonhomework::results{"resource.$part.$id.scantron"}.=
$response;	$response;
if ($resulttype ne 'letter') {	if ($resulttype ne 'letter') {
if ($resulttype eq 'A is 1') {	$response = $let_to_num{$response};
$response = $let_to_num{$response}+1;	if ($resulttype eq 'A is 1') {
} else {	if ($response ne "") {
$response = $let_to_num{$response};	$response = $response+1;
	}
}	}
if ($response ne "") {	if ($response ne "") {
$response += $line * $bubbles_per_line;	$response += $line * $bubbles_per_line;
}	}
} else {	} else {
if ($response ne "") {	if ($response ne "") {
	my $raw = $response;
$response = chr(ord($response) + $line * $bubbles_per_line);	$response = chr(ord($response) + $line * $bubbles_per_line);
}	}
}	}
Line 947 sub getresponse {	Line 1043 sub getresponse {

=item &repetition();	=item &repetition();

Returns the number of lines that are required to encode the weight.	In scalar context:
(Currently expects that there are 10 bubbles per line)
	returns: the number of lines that are required to encode the weight.
	(Default is for 10 bubbles per bubblesheet item; other (integer)
	values can be specified by using a custom Bubblesheet format file
	with an eighteenth entry (BubblesPerRow) set to the integer
	appropriate for the bubblesheets which will be used to assign weights.

	In array context:

	returns: number of lines required to encode weight, and bubbles/line.

=cut	=cut

Line 956 sub repetition {	Line 1061 sub repetition {
my $id = $Apache::inputtags::part;	my $id = $Apache::inputtags::part;
my $weight = &Apache::lonnet::EXT("resource.$id.weight");	my $weight = &Apache::lonnet::EXT("resource.$id.weight");
if (!defined($weight) \|\| ($weight eq '')) { $weight=1; }	if (!defined($weight) \|\| ($weight eq '')) { $weight=1; }
my $repetition = int($weight/10);	my $bubbles_per_row;
if ($weight % 10 != 0) { $repetition++; }	if (($env{'form.bubbles_per_row'} =~ /^\d+$/) &&
	($env{'form.bubbles_per_row'} > 0)) {
	$bubbles_per_row = $env{'form.bubbles_per_row'};
	} else {
	$bubbles_per_row = 10;
	}
	my $denominator = $bubbles_per_row;
	if (($env{'form.scantron_lastbubblepoints'} == 0) &&
	($bubbles_per_row > 1)) {
	$denominator = $bubbles_per_row - 1;
	}
	my $repetition = int($weight/$denominator);
	if ($weight % $denominator != 0) { $repetition++; }
	if (wantarray) {
	return ($repetition,$bubbles_per_row);
	}
return $repetition;	return $repetition;

}	}

=pod	=pod

=item &scored_response($part_id,$response_id);	=item &scored_response();

Sets the results hash elements	Sets the results hash elements

Line 988 Arguments	Line 1109 Arguments
sub scored_response {	sub scored_response {
my ($part,$id)=@_;	my ($part,$id)=@_;
my $repetition=&repetition();	my $repetition=&repetition();
	my $bubbles_per_row;
	if (($env{'form.bubbles_per_row'} =~ /^\d+$/) &&
	($env{'form.bubbles_per_row'} > 0)) {
	$bubbles_per_row = $env{'form.bubbles_per_row'};
	} else {
	$bubbles_per_row = 10;
	}
my $score=0;	my $score=0;
for (my $i=0;$i<$repetition;$i++) {	for (my $i=0;$i<$repetition;$i++) {
# A is 1, B is 2, etc. (get response return 0-9 and then we add 1)	# A is 1, B is 2, etc.
my $increase=&Apache::response::getresponse($i+1);	my $increase=&Apache::response::getresponse($i+1);
if ($increase ne '') { $score+=$increase+1; }	unless (($increase == $bubbles_per_row-1) &&
	($env{'form.scantron_lastbubblepoints'} == 0)) {
	# (get response return 0-9 and then we add 1)
	if ($increase ne '') {
	$score+=$increase+1;
	}
	}
}	}
my $weight = &Apache::lonnet::EXT("resource.$part.weight");	my $weight = &Apache::lonnet::EXT("resource.$part.weight");
if (!defined($weight) \|\| $weight eq '' \|\| $weight eq 0) { $weight = 1; }	if (!defined($weight) \|\| $weight eq '' \|\| $weight eq 0) { $weight = 1; }
Line 1004 sub scored_response {	Line 1138 sub scored_response {
}	}

sub whichorder {	sub whichorder {
my ($max,$randomize,$showall,$hash)=@_;	my ($max,$randomize,$showall,$hash,$rndseed)=@_;
#&Apache::lonxml::debug("man $max randomize $randomize");	#&Apache::lonxml::debug("man $max randomize $randomize");
if (!defined(@{ $$hash{'names'} })) { return; }	my @names;
my @names = @{ $$hash{'names'} };	if (ref($hash->{'names'}) eq 'ARRAY') {
	@names = @{$hash->{'names'}};
	}
	return if (!@names);
my @whichopt =();	my @whichopt =();
my (%top,@toplist,%bottom,@bottomlist);	my (%top,@toplist,%bottom,@bottomlist);
if (!($showall \|\| ($randomize eq 'no'))) {	if (!($showall \|\| ($randomize eq 'no'))) {
Line 1058 sub show_answer {	Line 1195 sub show_answer {
my $part = $Apache::inputtags::part;	my $part = $Apache::inputtags::part;
my $award = $Apache::lonhomework::history{"resource.$part.solved"};	my $award = $Apache::lonhomework::history{"resource.$part.solved"};
my $status = $Apache::inputtags::status[-1];	my $status = $Apache::inputtags::status[-1];
return ( ($award =~ /^correct/	my $canshow = 0;
&& &Apache::lonhomework::show_problem_status())	if ($award =~ /^correct/) {
\|\| $status eq "SHOW_ANSWER");	if (($Apache::lonhomework::history{"resource.$part.awarded"} >= 1) \|\|
	(&Apache::lonnet::EXT("resource.$part.retrypartial") !~/^1\|on\|yes$/)) {
	$canshow = 1;
	}
	}
	return (($canshow && &Apache::lonhomework::show_problem_status())
	\|\| $status eq "SHOW_ANSWER");
}	}

sub analyze_store_foilgroup {	sub analyze_store_foilgroup {
Line 1088 sub check_if_computed {	Line 1231 sub check_if_computed {

sub pick_foil_for_concept {	sub pick_foil_for_concept {
my ($target,$attrs,$hinthash,$parstack,$safeeval)=@_;	my ($target,$attrs,$hinthash,$parstack,$safeeval)=@_;
if (not defined(@{ $Apache::response::conceptgroup{'names'} })) { return; }	my @names;
my @names = @{ $Apache::response::conceptgroup{'names'} };	if (ref($Apache::response::conceptgroup{'names'}) eq 'ARRAY') {
	@names = @{ $Apache::response::conceptgroup{'names'} };
	}
	return if (!@names);
my $pick=int(&Math::Random::random_uniform() * ($#names+1));	my $pick=int(&Math::Random::random_uniform() * ($#names+1));
my $name=$names[$pick];	my $name=$names[$pick];
push @{ $Apache::response::foilgroup{'names'} }, $name;	push @{ $Apache::response::foilgroup{'names'} }, $name;
Line 1120 sub pick_foil_for_concept {	Line 1266 sub pick_foil_for_concept {
$Apache::response::conceptgroup{'names'};	$Apache::response::conceptgroup{'names'};

}	}
#------------------------------------------------------------
#	=pod
# Get a parameter associated with a problem.
# Parameters:	=item get_response_param()
# $id - the id of the paramater, either a part id,
# or a partid and responspe id joined by _	Get a parameter associated with a problem.
# $name - Name of the parameter to fetch	Parameters:
# $default - Default value for the paramter.	$id - the id of the paramater, either a part id,
#	or a partid and responspe id joined by _
#	$name - Name of the parameter to fetch
#	$default - Default value for the paramter.

	=cut

sub get_response_param {	sub get_response_param {
my ($id,$name,$default)=@_;	my ($id,$name,$default)=@_;
my $parameter;	my $parameter;
Line 1164 sub submitted {	Line 1313 sub submitted {
}	}
# Submit All button on a .page was pressed	# Submit All button on a .page was pressed
if (defined($env{'form.all_submit'})) { return 1; }	if (defined($env{'form.all_submit'})) { return 1; }
# otherwise no submission occured	# otherwise no submission occurred
return 0;	return 0;
}	}

Line 1191 sub add_to_gradingqueue {	Line 1340 sub add_to_gradingqueue {
}	}
}	}

# basically undef and 0 (both false) mean that they still have work to do	=pod
# and all true values mean that they can't do any more work
#	=item check_status()
# a return of undef means it is unattempted
# a return of 0 means it is attmpted and wrong but still has tries	basically undef and 0 (both false) mean that they still have work to do
# a return of 1 means it is marked correct	and all true values mean that they can't do any more work
# a return of 2 means they have exceed maximum number of tries
# a return of 3 means it after the answer date	a return of undef means it is unattempted
	a return of 0 means it is both attempted and still has tries and
	is wrong or is only partially correct, and retries
	are allowed.
	a return of 1 means it is marked correct
	a return of 2 means they have exceeded maximum number of tries
	a return of 3 means it is after the answer date

	=cut

sub check_status {	sub check_status {
my ($id)=@_;	my ($id)=@_;
if (!defined($id)) { $id=$Apache::inputtags::part; }	if (!defined($id)) { $id=$Apache::inputtags::part; }
my $curtime=&Apache::lonnet::EXT('system.time');	my $curtime=&Apache::lonnet::EXT('system.time');
my $opendate=&Apache::lonnet::EXT("resource.$id.opendate");	my $opendate=&Apache::lonnet::EXT("resource.$id.opendate");
my $duedate=&Apache::lonnet::EXT("resource.$id.duedate");	my $duedate=&Apache::lonhomework::due_date($id);
my $answerdate=&Apache::lonnet::EXT("resource.$id.answerdate");	my $answerdate=&Apache::lonnet::EXT("resource.$id.answerdate");
if ( $opendate && $curtime > $opendate &&	if ( $opendate && $curtime > $opendate &&
$duedate && $curtime > $duedate &&	$duedate && $curtime > $duedate &&
Line 1212 sub check_status {	Line 1370 sub check_status {
return 3;	return 3;
}	}
my $status=&Apache::lonnet::EXT("user.resource.resource.$id.solved");	my $status=&Apache::lonnet::EXT("user.resource.resource.$id.solved");
if ($status =~ /^correct/) { return 1; }	if ($status =~ /^correct/) {
	my $awarded=&Apache::lonnet::EXT("user.resource.resource.$id.awarded");
	my $retrypartial=&Apache::lonnet::EXT("resource.$id.retrypartial");
	unless (($retrypartial =~ /^1\|on\|yes$/) && ($awarded <1)) {
	return 1;
	}
	}
if (!$status) { return undef; }	if (!$status) { return undef; }
my $maxtries=&Apache::lonnet::EXT("resource.$id.maxtries");	my $maxtries=&Apache::lonnet::EXT("resource.$id.maxtries");
if ($maxtries eq '') { $maxtries=2; }	if ($maxtries eq '') { $maxtries=2; }
Line 1223 sub check_status {	Line 1387 sub check_status {

=pod	=pod

=item setup_prior_tries_hash($func,$data)	=item setup_prior_tries_hash()

Foreach each past .submission $func is called with 3 arguments	Foreach each past .submission $func is called with 3 arguments
- the mode to set things up for (currently always 'grade')	- the mode to set things up for (currently always 'grade')
Line 1234 sub check_status {	Line 1398 sub check_status {
- scalars that are other elements of the history hash to pass to $func	- scalars that are other elements of the history hash to pass to $func
- ref to data to be passed untouched to $func	- ref to data to be passed untouched to $func

	$questiontype is the questiontype (currently only passed in if
	randomizebytry.

=cut	=cut

sub setup_prior_tries_hash {	sub setup_prior_tries_hash {
my ($func,$data) = @_;	my ($func,$data,$questiontype) = @_;
my $part = $Apache::inputtags::part;	my $part = $Apache::inputtags::part;
my $id = $Apache::inputtags::response[-1];	my $id = $Apache::inputtags::response[-1];
foreach my $i (1..$Apache::lonhomework::history{'version'}) {	foreach my $i (1..$Apache::lonhomework::history{'version'}) {
my $sub_key = "$i:resource.$part.$id.submission";	my $partprefix = "$i:resource.$part";
	my $sub_key = "$partprefix.$id.submission";
next if (!exists($Apache::lonhomework::history{$sub_key}));	next if (!exists($Apache::lonhomework::history{$sub_key}));
	my $type_key = "$partprefix.type";
	my $type = $Apache::lonhomework::history{$type_key};
my @other_data;	my @other_data;
foreach my $datum (@{ $data }) {	if (ref($data) eq 'ARRAY') {
if (ref($datum)) {	foreach my $datum (@{ $data }) {
push(@other_data,$datum);	if (ref($datum)) {
} else {	push(@other_data,$datum);
my $info_key = "$i:resource.$part.$id.$datum";	} else {
push(@other_data,$Apache::lonhomework::history{$info_key});	my $info_key = "$i:resource.$part.$id.$datum";
	push(@other_data,$Apache::lonhomework::history{$info_key});
	}
}	}
}	}
	if ($questiontype eq 'randomizetry') {
	my $order_key = "$partprefix.$id.foilorder";
	my @whichopts = &Apache::lonnet::str2array($Apache::lonhomework::history{$order_key});
	if (@whichopts > 0) {
	shift(@other_data);
	unshift(@other_data,\@whichopts);
	}
	}
my $output =	my $output =
&$func('grade',	&$func('grade',
$Apache::lonhomework::history{$sub_key},	$Apache::lonhomework::history{$sub_key},
Line 1266 sub setup_prior_tries_hash {	Line 1445 sub setup_prior_tries_hash {
1;	1;
__END__	__END__

	=pod

	=cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.188
changed lines
	Added in v.1.246