Return to caparesponse.pm CVS log

Up to [LON-CAPA] / loncom / homework / caparesponse

Diff for /loncom/homework/caparesponse/caparesponse.pm between versions 1.198.2.2 and 1.256

version 1.198.2.2, 2006/12/19 00:53:57	version 1.256, 2015/10/30 03:49:55
Line 33 use Safe::Hole;	Line 33 use Safe::Hole;
use Apache::lonmaxima();	use Apache::lonmaxima();
use Apache::lonlocal;	use Apache::lonlocal;
use Apache::lonnet;	use Apache::lonnet;
	use Apache::lonmsg();
	use Apache::response();
use Storable qw(dclone);	use Storable qw(dclone);
	use Apache::lonnet;

BEGIN {	BEGIN {
&Apache::lonxml::register('Apache::caparesponse',('numericalresponse','stringresponse','formularesponse'));	&Apache::lonxml::register('Apache::caparesponse',('numericalresponse','stringresponse','formularesponse'));
Line 41 BEGIN {	Line 44 BEGIN {

my %answer;	my %answer;
my @answers;	my @answers;
	my @alphabet=('A'..'Z');

sub get_answer { return %answer; };	sub get_answer { return %answer; };
sub push_answer{ push(@answers,dclone(\%answer)); undef(%answer) }	sub push_answer{ push(@answers,dclone(\%answer)); undef(%answer) }
sub pop_answer { %answer = %{pop(@answers)}; };	sub pop_answer { %answer = %{pop(@answers)}; };
Line 60 sub start_answer {	Line 65 sub start_answer {
if (!defined($type)) { $type = 'ordered' };	if (!defined($type)) { $type = 'ordered' };
$answer{$cur_name}= { 'type' => $type,	$answer{$cur_name}= { 'type' => $type,
'answers' => [] };	'answers' => [] };
	if ($target eq 'edit') {
	$result.=&Apache::edit::tag_start($target,$token);
	$result.=&Apache::edit::text_arg('Name:','name',$token);
	$result.=&Apache::edit::select_arg('Type:','type',
	[['ordered', 'Ordered' ],
	['unordered','Unordered'],],
	$token);
	$result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row();
	} elsif ($target eq 'modified') {
	my $constructtag = &Apache::edit::get_new_args($token,$parstack,
	$safeeval,'name',
	'type');
	if ($constructtag) {
	$result = &Apache::edit::rebuild_tag($token);
	$result.= &Apache::edit::handle_insert();
	}
	}
return $result;	return $result;
}	}

sub end_answer {	sub end_answer {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
my $result;	my $result;
	if ($target eq 'edit') {
	$result .= &Apache::edit::tag_end();
	}

undef($cur_name);	undef($cur_name);
return $result;	return $result;
}	}

	sub insert_answer {
	return '
	<answer>
	<value></value>
	</answer>';
	}

sub start_answergroup {	sub start_answergroup {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
my $result;	my $result;
	if ($target eq 'edit') {
	$result.=&Apache::edit::tag_start($target,$token);
	$result.=&Apache::edit::select_arg('Type:','type',
	[['ordered', 'Ordered' ],
	['unordered','Unordered'],],
	$token);
	$result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row();
	} elsif ($target eq 'modified') {
	my $constructtag = &Apache::edit::get_new_args($token,$parstack,
	$safeeval,'name',
	'type');
	if ($constructtag) {
	$result = &Apache::edit::rebuild_tag($token);
	$result.= &Apache::edit::handle_insert();
	}
	}
return $result;	return $result;
}	}

Line 87 sub end_answergroup {	Line 136 sub end_answergroup {
$target,$token,$tagstack,$parstack,$parser,	$target,$token,$tagstack,$parstack,$parser,
$safeeval,-2);	$safeeval,-2);
}	}
	} elsif ($target eq 'edit') {
	$result .= &Apache::edit::tag_end();
}	}
return $result;	return $result;
}	}

	sub insert_answergroup {
	return '
	<answergroup>
	<answer>
	<value></value>
	</answer>
	</answergroup>';
	}

sub start_value {	sub start_value {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result;	my $result;
Line 103 sub start_value {	Line 163 sub start_value {

push(@{ $answer{$cur_name}{'answers'} },[$bodytext]);	push(@{ $answer{$cur_name}{'answers'} },[$bodytext]);

	} elsif ($target eq 'edit') {
	$result.=&Apache::edit::tag_start($target,$token);
	my $bodytext = &Apache::lonxml::get_all_text("/value",$parser,$style);
	$result.=&Apache::edit::editline($token->[1],$bodytext,undef,40).
	&Apache::edit::end_row();
	} elsif ($target eq 'modified') {
	$result=$token->[4].&Apache::edit::modifiedfield('/value',$parser);
}	}
return $result;	return $result;
}	}
Line 110 sub start_value {	Line 177 sub start_value {
sub end_value {	sub end_value {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
my $result;	my $result;
	if ($target eq 'edit') {
	$result = &Apache::edit::end_table();
	}
return $result;	return $result;
}	}

	sub insert_value {
	return '
	<value></value>';
	}

sub start_vector {	sub start_vector {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result;	my $result;
Line 125 sub start_vector {	Line 200 sub start_vector {
@values = split(',',$values[0]);	@values = split(',',$values[0]);
}	}
push(@{ $answer{$cur_name}{'answers'} },\@values);	push(@{ $answer{$cur_name}{'answers'} },\@values);
	} elsif ($target eq 'edit') {
	$result.=&Apache::edit::tag_start($target,$token);
	my $bodytext = &Apache::lonxml::get_all_text("/vector",$parser,$style);
	$result.=&Apache::edit::editline($token->[1],$bodytext,undef,40).
	&Apache::edit::end_row();
	} elsif ($target eq 'modified') {
	$result=$token->[4].&Apache::edit::modifiedfield('/vector',$parser);
}	}
return $result;	return $result;
}	}
Line 132 sub start_vector {	Line 214 sub start_vector {
sub end_vector {	sub end_vector {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
my $result;	my $result;
	if ($target eq 'edit') {
	$result = &Apache::edit::end_table();
	}
return $result;	return $result;
}	}

	sub insert_vector {
	return '
	<value></value>';
	}

sub start_array {	sub start_array {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result;	my $result;
Line 172 sub start_numericalresponse {	Line 262 sub start_numericalresponse {
&Apache::lonxml::register('Apache::caparesponse',	&Apache::lonxml::register('Apache::caparesponse',
('answer','answergroup','value','array','unit',	('answer','answergroup','value','array','unit',
'vector'));	'vector'));
	push(@Apache::lonxml::namespace,'caparesponse');
my $id = &Apache::response::start_response($parstack,$safeeval);	my $id = &Apache::response::start_response($parstack,$safeeval);
my $result;	my $result;
undef(%answer);	undef(%answer);
Line 192 sub start_numericalresponse {	Line 283 sub start_numericalresponse {
$token,40).	$token,40).
&Apache::loncommon::help_open_topic('Formula_Response_Sampling');	&Apache::loncommon::help_open_topic('Formula_Response_Sampling');
}	}
	$result.=&Apache::edit::text_arg('Pre-Processor Subroutine:','preprocess',
	$token,10);
$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 199 sub start_numericalresponse {	Line 292 sub start_numericalresponse {
$constructtag=&Apache::edit::get_new_args($token,$parstack,	$constructtag=&Apache::edit::get_new_args($token,$parstack,
$safeeval,'answer',	$safeeval,'answer',
'incorrect','unit',	'incorrect','unit',
'format');	'format','preprocess');
} elsif ($token->[1] eq 'formularesponse') {	} elsif ($token->[1] eq 'formularesponse') {
$constructtag=&Apache::edit::get_new_args($token,$parstack,	$constructtag=&Apache::edit::get_new_args($token,$parstack,
$safeeval,'answer',	$safeeval,'answer',
'samples');	'samples','preprocess');
}	}
if ($constructtag) {	if ($constructtag) {
$result = &Apache::edit::rebuild_tag($token);	$result = &Apache::edit::rebuild_tag($token);
Line 218 sub start_numericalresponse {	Line 311 sub start_numericalresponse {
my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffunit');	my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffunit');
&Apache::lonxml::debug("Got unit $hideunit for $partid $id");	&Apache::lonxml::debug("Got unit $hideunit for $partid $id");
#no way to enter units, with radio buttons	#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,	my $unit=&Apache::lonxml::get_param_var('unit',$parstack,
$safeeval);	$safeeval);
if ($unit =~ /\S/) { $result.=" (in $unit) "; }	if ($unit =~ /\S/) { $result.=" (in $unit) "; }
Line 236 sub set_answertext {	Line 329 sub set_answertext {
$response_level) = @_;	$response_level) = @_;
&add_in_tag_answer($parstack,$safeeval,$response_level);	&add_in_tag_answer($parstack,$safeeval,$response_level);

	if ($name eq '' \|\| !ref($answer{$name})) {
	if (ref($answer{$tag_internal_answer_name})) {
	$name = $tag_internal_answer_name;
	} else {
	$name = (sort(keys(%answer)))[0];
	}
	}
return if ($name eq '' \|\| !ref($answer{$name}));	return if ($name eq '' \|\| !ref($answer{$name}));

my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,	my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,
Line 298 sub setup_capa_args {	Line 398 sub setup_capa_args {
sub setup_capa_response {	sub setup_capa_response {
my ($args_ref,$response) = @_;	my ($args_ref,$response) = @_;

use Data::Dumper;
&Apache::lonxml::debug("response dump is ".&Dumper($response));

if (ref($response)) {	if (ref($response)) {
$$args_ref{'response'}=dclone($response);	$$args_ref{'response'}=dclone($response);
} else {	} else {
Line 310 sub setup_capa_response {	Line 407 sub setup_capa_response {

sub check_submission {	sub check_submission {
my ($response,$partid,$id,$tag,$parstack,$safeeval,$ignore_sig)=@_;	my ($response,$partid,$id,$tag,$parstack,$safeeval,$ignore_sig)=@_;
my @args = ('type','tol','sig','format','unit','calc','samples');	my @args = ('type','tol','sig','format','unit','calc','samples','preprocess');
my $args_ref = &setup_capa_args($safeeval,$parstack,\@args,$response);	my $args_ref = &setup_capa_args($safeeval,$parstack,\@args,$response);

my $hideunit=	my $hideunit=
Line 329 sub check_submission {	Line 426 sub check_submission {
}	}

if ($tag eq 'formularesponse') {	if ($tag eq 'formularesponse') {
# if ($$args_ref{'samples'}) {	if ($$args_ref{'samples'}) {
$$args_ref{'type'}='fml';	$$args_ref{'type'}='fml';
# } else {	} else {
# $$args_ref{'type'}='math';	$$args_ref{'type'}='math';
# }	}
} elsif ($tag eq 'numericalresponse') {	} elsif ($tag eq 'numericalresponse') {
$$args_ref{'type'}='float';	$$args_ref{'type'}='float';
	} elsif ($tag eq 'stringresponse') {
	if ($$args_ref{'type'} eq '') {
	$$args_ref{'type'} = 'ci';
	}
}	}

&add_in_tag_answer($parstack,$safeeval);	&add_in_tag_answer($parstack,$safeeval);

	if (!%answer) {
	&Apache::lonxml::error("No answers are defined");
	}

my (@final_awards,@final_msgs,@names);	my (@final_awards,@final_msgs,@names);
foreach my $name (keys(%answer)) {	foreach my $name (keys(%answer)) {
&Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} }));	&Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} }));
Line 366 sub check_submission {	Line 471 sub check_submission {
return($ad,$msg, $name);	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 {	sub add_in_tag_answer {
my ($parstack,$safeeval,$response_level) = @_;	my ($parstack,$safeeval,$response_level) = @_;
my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval,	my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval,
$response_level);	$response_level);
&Apache::lonxml::debug('answer is'.join(':',@answer));	&Apache::lonxml::debug('answer is'.join(':',@answer));
if (@answer && defined($answer[0])) {	if (@answer && $answer[0] =~ /\S/) {
$answer{$tag_internal_answer_name}= {'type' => 'ordered',	$answer{$tag_internal_answer_name}= {'type' => 'ordered',
'answers' => [\@answer] };	'answers' => [\@answer] };
}	}
}	}

	sub capa_formula_fix {
	my ($expression)=@_;
	return &Apache::response::implicit_multiplication($expression);
	}

sub end_numericalresponse {	sub end_numericalresponse {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;

	&Apache::lonxml::deregister('Apache::caparesponse',
	('answer','answergroup','value','array','unit',
	'vector'));
	pop(@Apache::lonxml::namespace);

my $increment=1;	my $increment=1;
my $result = '';	my $result = '';
if (!$Apache::lonxml::default_homework_loaded) {	if (!$Apache::lonxml::default_homework_loaded) {
Line 389 sub end_numericalresponse {	Line 547 sub end_numericalresponse {
my $tag;	my $tag;
my $safehole = new Safe::Hole;	my $safehole = new Safe::Hole;
$safeeval->share_from('capa',['&caparesponse_capa_check_answer']);	$safeeval->share_from('capa',['&caparesponse_capa_check_answer']);
$safehole->wrap(\&Apache::lonmaxima::maxima_check,$safeeval,'&maxima_check');

if (scalar(@$tagstack)) { $tag=$$tagstack[-1]; }	if (scalar(@$tagstack)) { $tag=$$tagstack[-1]; }
if ( $target eq 'grade' && &Apache::response::submitted() ) {	if ( $target eq 'grade' && &Apache::response::submitted() ) {
Line 405 sub end_numericalresponse {	Line 562 sub end_numericalresponse {
&Apache::lonxml::debug($$parstack[-1] . "\n<br>");	&Apache::lonxml::debug($$parstack[-1] . "\n<br>");

if ( &Apache::response::submitted('scantron')) {	if ( &Apache::response::submitted('scantron')) {
my ($values,$display)=&make_numerical_bubbles($partid,$id,	&add_in_tag_answer($parstack,$safeeval);
$target,$parstack,$safeeval);	my ($values,$display)=&make_numerical_bubbles($partid,$id,
$response=$values->[$response];	$target,$parstack,$safeeval);
}	$response=$values->[$response];
$Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response;	}
	$Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response;
my ($ad,$msg,$name)=&check_submission($response,$partid,$id,	my ($ad,$msg,$name)=&check_submission($response,$partid,$id,
$tag,$parstack,	$tag,$parstack,
$safeeval);	$safeeval);
Line 423 sub end_numericalresponse {	Line 581 sub end_numericalresponse {
$Apache::inputtags::params{'sig'});	$Apache::inputtags::params{'sig'});
}	}
&Apache::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n");	&Apache::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n");
if ($Apache::lonhomework::type eq 'survey' &&	if (($ad eq 'INCORRECT' \|\| $ad eq 'APPROX_ANS' \|\|
($ad eq 'INCORRECT' \|\| $ad eq 'APPROX_ANS' \|\|	$ad eq 'EXACT_ANS')) {
$ad eq 'EXACT_ANS')) {	if ($Apache::lonhomework::type eq 'survey') {
$ad='SUBMITTED';	$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::response::handle_previous(\%previous,$ad);
$Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}=$ad;	$Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}=$ad;
$Apache::lonhomework::results{"resource.$partid.$id.awardmsg"}=$msg;	$Apache::lonhomework::results{"resource.$partid.$id.awardmsg"}=$msg;
Line 448 sub end_numericalresponse {	Line 613 sub end_numericalresponse {
my $number_of_bubbles = scalar(@{ $bubble_values });	my $number_of_bubbles = scalar(@{ $bubble_values });
my $unit=&Apache::lonxml::get_param_var('unit',$parstack,	my $unit=&Apache::lonxml::get_param_var('unit',$parstack,
$safeeval);	$safeeval);
my @alphabet=('A'..'Z');
if ($target eq 'web') {	if ($target eq 'web') {
if ($tag eq 'numericalresponse') {	if ($tag eq 'numericalresponse') {
if ($unit=~/\S/) {$result.=' (in '.$unit.')<br /><br />';}	if ($unit=~/\S/) {$result.=' (in '.$unit.')<br /><br />';}
Line 471 sub end_numericalresponse {	Line 635 sub end_numericalresponse {
$result.=' \textit{(in} \verb\|'.$unit.'\|\textit{)} ';	$result.=' \textit{(in} \verb\|'.$unit.'\|\textit{)} ';
}	}
if ($tag eq 'numericalresponse') {	if ($tag eq 'numericalresponse') {
my ($celllength,$number_of_tables,@table_range)=	$result .= &make_horizontal_latex_bubbles($bubble_values, $bubble_display,
&get_table_sizes($number_of_bubbles,$bubble_display);	'$\bigcirc$');
my $j=0;
my $cou=0;
$result.='\vskip -1 mm \noindent \begin{enumerate}\item[\textbf{'.$Apache::lonxml::counter.'}.]';
for (my $i=0;$i<$number_of_tables;$i++) {
$result.='\vskip -1 mm \noindent \setlength{\tabcolsep}{2 mm}\begin{tabular}{';
for (my $ind=0;$ind<$table_range[$j];$ind++) {
$result.='p{3 mm}p{'.$celllength.' mm}';
}
$result.='}';
for (my $ind=$cou;$ind<$cou+$table_range[$j];$ind++) {
$result.='\hskip -4 mm {\small \textbf{'.$alphabet[$ind].'}}$\bigcirc$ & \hskip -3 mm {\small '.$bubble_display->[$ind].'} ';
if ($ind != $cou+$table_range[$j]-1) {$result.=' & ';}
}
$cou += $table_range[$j];
$j++;
$result.='\\\\\end{tabular}\vskip 0 mm ';
}
$result.='\end{enumerate}';
} else {	} else {
$increment = &Apache::response::repetition();	$increment = &Apache::response::repetition();
}	}
}	}
}	}

	&Apache::response::setup_prior_tries_hash(\&format_prior_response_numerical);
} elsif ($target eq 'edit') {	} elsif ($target eq 'edit') {
$result.='</td></tr>'.&Apache::edit::end_table;	$result.='</td></tr>'.&Apache::edit::end_table;
} elsif ($target eq 'answer' \|\| $target eq 'analyze') {	} elsif ($target eq 'answer' \|\| $target eq 'analyze') {
Line 571 sub end_numericalresponse {	Line 719 sub end_numericalresponse {
#}	#}
}	}
if ($high && $tag eq 'numericalresponse') {	if ($high && $tag eq 'numericalresponse') {
$element.=' ['.$low.','.$high.']';	$element.='; ['.$low.'; '.$high.']';
$tolline .= "[$low, $high]";	$tolline .= "[$low, $high]";
}	}
if (defined($sighigh) && $tag eq 'numericalresponse') {	if (defined($sighigh) && $tag eq 'numericalresponse') {
if ($env{'form.answer_output_mode'} eq 'tex') {	if ($env{'form.answer_output_mode'} eq 'tex') {
$element.= " Sig $siglow - $sighigh";	$element.= "; Sig $siglow - $sighigh";
} else {	} else {
$element.= " Sig <i>$siglow - $sighigh</i>";	$element.= " Sig <i>$siglow - $sighigh</i>";
$sigline .= "[$siglow, $sighigh]";	$sigline .= "[$siglow, $sighigh]";
Line 596 sub end_numericalresponse {	Line 744 sub end_numericalresponse {
}	}
}	}
if ($target eq 'answer') {	if ($target eq 'answer') {
$result.= &Apache::response::answer_part($tag,join(', ',@all_answer_info));	$result.= &Apache::response::answer_part($tag,join('; ',@all_answer_info));
}	}
}	}

Line 635 sub end_numericalresponse {	Line 783 sub end_numericalresponse {
if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {	if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
my $error;	my $error;
if ($tag eq 'formularesponse') {	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 {	} else {
# answer failed check if it is sig figs that is failing	# answer failed check if it is sig figs that is failing
my ($ad,$msg)=&check_submission($response,$partid,$id,	my ($ad,$msg)=&check_submission($response,$partid,$id,
$tag,$parstack,	$tag,$parstack,
$safeeval,1);	$safeeval,1);
	$error=&mt("Computer's answer is incorrect ([_1]).",'"'.join(', ',@$response).'"').' ';
if ($sigline ne '') {	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 {	} 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') {	if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
Line 680 sub end_numericalresponse {	Line 829 sub end_numericalresponse {
}	}
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($increment);	if (($tag eq 'formularesponse') && ($target eq 'analyze')) {
	my $type = &Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.type');
	if ($type eq 'exam') {
	$increment = &Apache::response::repetition();
	}
	}
	&Apache::lonxml::increment_counter($increment,"$partid.$id");
	if ($target eq 'analyze') {
	&Apache::lonhomework::set_bubble_lines();
	}
}	}
&Apache::response::end_response();	&Apache::response::end_response();
return $result;	return $result;
}	}

	sub format_prior_response_numerical {
	my ($mode,$answer) = @_;
	if (ref($answer)) {
	my $result = '<table class="LC_prior_numerical"><tr>';
	foreach my $element (@{ $answer }) {
	$result.= '<td><span class="LC_prior_numerical">'.
	&HTML::Entities::encode($element,'"<>&').'</span></td>';
	}
	$result.='</tr></table>';
	return $result;
	}
	return '<span class="LC_prior_numerical">'.
	&HTML::Entities::encode($answer,'"<>&').'</span>';

	}

sub check_for_answer_errors {	sub check_for_answer_errors {
my ($parstack,$safeeval) = @_;	my ($parstack,$safeeval) = @_;
&add_in_tag_answer($parstack,$safeeval);	&add_in_tag_answer($parstack,$safeeval);
Line 702 sub check_for_answer_errors {	Line 876 sub check_for_answer_errors {
} (sort(keys(%counts))));	} (sort(keys(%counts))));
&Apache::lonxml::error(&mt("All answers must have the same number of components. Varying numbers of answers were seen. ").$counts);	&Apache::lonxml::error(&mt("All answers must have the same number of components. Varying numbers of answers were seen. ").$counts);
}	}
use Data::Dumper;
&Apache::lonxml::debug("count dump is ".&Dumper(\%counts));
my $expected_number_of_inputs = (keys(%counts))[0];	my $expected_number_of_inputs = (keys(%counts))[0];
if ( $expected_number_of_inputs != scalar(@Apache::inputtags::inputlist)) {	if ( $expected_number_of_inputs > 0
	&& $expected_number_of_inputs != scalar(@Apache::inputtags::inputlist)) {
&Apache::lonxml::error(&mt("Expected [_1] input fields, but there were only [_2] seen.",	&Apache::lonxml::error(&mt("Expected [_1] input fields, but there were only [_2] seen.",
$expected_number_of_inputs,	$expected_number_of_inputs,
scalar(@Apache::inputtags::inputlist)));	scalar(@Apache::inputtags::inputlist)));
Line 741 sub get_table_sizes {	Line 914 sub get_table_sizes {
my $bubbles_per_line=int($textwidth/$cell_width);	my $bubbles_per_line=int($textwidth/$cell_width);
if ($bubbles_per_line > $number_of_bubbles) {	if ($bubbles_per_line > $number_of_bubbles) {
$bubbles_per_line=$number_of_bubbles;	$bubbles_per_line=$number_of_bubbles;
}elsif (($bubbles_per_line > $number_of_bubbles/2) && ($number_of_bubbles % 2==0)) {$bubbles_per_line=$number_of_bubbles/2;}	} elsif (($bubbles_per_line > $number_of_bubbles/2)
	&& ($number_of_bubbles % 2==0)) {
	$bubbles_per_line=$number_of_bubbles/2;
	}
	if ($bubbles_per_line < 1) {
	$bubbles_per_line=1;
	}
my $number_of_tables = int($number_of_bubbles/$bubbles_per_line);	my $number_of_tables = int($number_of_bubbles/$bubbles_per_line);
my @table_range = ();	my @table_range = ();
for (my $i=0;$i<$number_of_tables;$i++) {push @table_range,$bubbles_per_line;}	for (my $i=0;$i<$number_of_tables;$i++) {push @table_range,$bubbles_per_line;}
Line 776 sub format_number {	Line 955 sub format_number {

sub make_numerical_bubbles {	sub make_numerical_bubbles {
my ($part,$id,$target,$parstack,$safeeval) =@_;	my ($part,$id,$target,$parstack,$safeeval) =@_;

	if (!%answer) {
	&Apache::lonxml::error(&mt("No answers defined for response [_1] in part [_2] to make bubbles for.",$id,$part));
	return ([],[],undef);
	}

my $number_of_bubbles =	my $number_of_bubbles =
&Apache::response::get_response_param($part.'_'.$id,'numbubbles',8);	&Apache::response::get_response_param($part.'_'.$id,'numbubbles',8);

	#
	# Fixes for BZ 6519 - number of bubbles <= 0 or non-integer.
	#
	$number_of_bubbles = int($number_of_bubbles + 0.5);
	if ($number_of_bubbles <= 0) {
	$number_of_bubbles = 8;
	}


my ($format)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);	my ($format)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);
my $name = (exists($answer{$tag_internal_answer_name})	my $name = (exists($answer{$tag_internal_answer_name})
? $tag_internal_answer_name	? $tag_internal_answer_name
Line 846 sub make_numerical_bubbles {	Line 1039 sub make_numerical_bubbles {
$ind=&Math::Random::random_uniform_integer(1,0,$#factors);	$ind=&Math::Random::random_uniform_integer(1,0,$#factors);
my $factor = $factors[$ind];	my $factor = $factors[$ind];
my @bubble_display;	my @bubble_display;
	my $answerfactor=$answer;
	if ($answer==0) {
	$answerfactor=&Math::Random::random_uniform_integer(1,1,100)/
	&Math::Random::random_uniform_integer(1,1,10);
	}
for ($ind=0;$ind<$number_of_bubbles;$ind++) {	for ($ind=0;$ind<$number_of_bubbles;$ind++) {
$bubble_values[$ind] = $answer($factor*($power-$powers[$#powers-$ind]));	$bubble_values[$ind] = $answerfactor($factor*($power-$powers[$#powers-$ind]));
$bubble_display[$ind] = &format_number($bubble_values[$ind],	$bubble_display[$ind] = &format_number($bubble_values[$ind],
$format,$target,$safeeval);	$format,$target,$safeeval);

}	}
my $correct = $alphabet[$number_of_bubbles-$power];	my $correct = $alphabet[$number_of_bubbles-$power];
	if ($answer==0) {
	$correct='A';
	$bubble_values[0]=0;
	$bubble_display[0] = &format_number($bubble_values[0],
	$format,$target,$safeeval);
	}
&Math::Random::random_set_seed(@oldseed);	&Math::Random::random_set_seed(@oldseed);
return (\@bubble_values,\@bubble_display,$correct);	return (\@bubble_values,\@bubble_display,$correct);
}	}

	##
	# Produce LaTeX bubbles laid out horizontally given a set of bubble values:
	#
	# @param bubble_values - reference to an array of bubble 'values'
	# @param bubble_display - reference to the array of texts to display to the user
	# for each bubble_value (this is mostly for numerical response
	# when the displayed value may not be an exact
	# representation of the bubble value.
	# @param bubble_fragment- The LaTeX fragment that will be plugged in to make
	# the bubble itself. Note that the code will autonomously
	# label each bubble with a lable...and that it's perfectly
	# acceptable to use "" for the bubble_fragment.
	#
	# @return string - the LaTeX fragment that produces the bubbles.
	#
	sub make_horizontal_latex_bubbles {
	my ($bubble_values, $bubble_display, $bubble_fragment) = @_;
	my $result;

	my $number_of_bubbles = scalar(@{$bubble_values});

	# Get the number of rows and columns in each row of the bubble
	# table:

	my ($celllength, $number_of_tables, @table_range) =
	&get_table_sizes($number_of_bubbles, $bubble_display);

	my $j=0;
	my $cou=0;
	$result.='\vskip 2mm \noindent ';
	$result .= '\textbf{'.$Apache::lonxml::counter.'.} \vskip -3mm ';

	for (my $i=0;$i<$number_of_tables;$i++) {
	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{4 mm}p{'.$celllength.' mm}';
	}
	$result.='}';
	for (my $ind=$cou;$ind<$cou+$table_range[$j];$ind++) {
	$result.='\hskip -4 mm {\small \textbf{ '.$alphabet[$ind].'}}'
	. $bubble_fragment
	. '& \hskip -3 mm {\small '.$bubble_display->[$ind].'} ';
	if ($ind != $cou+$table_range[$j]-1) {
	$result.=' & ';
	}
	}
	$cou += $table_range[$j];
	$j++;
	$result.='\\\\\end{tabular}\vskip 0 mm ';
	}
	return $result;
	}

sub get_tolrange {	sub get_tolrange {
my ($ans,$tol)=@_;	my ($ans,$tol)=@_;
my ($high,$low);	my ($high,$low);
Line 876 sub get_sigrange {	Line 1137 sub get_sigrange {
my ($sig)=@_;	my ($sig)=@_;
#&Apache::lonxml::debug("Got a sig of :$sig:");	#&Apache::lonxml::debug("Got a sig of :$sig:");
my $courseid=$env{'request.course.id'};	my $courseid=$env{'request.course.id'};
if (lc($env{"course.$courseid.disablesigfigs"}) eq 'yes') {	if ($env{'request.state'} ne 'construct'
	&& lc($env{"course.$courseid.disablesigfigs"}) eq 'yes') {
return (15,0);	return (15,0);
}	}
my $sig_lbound;	my $sig_lbound;
Line 905 sub get_sigrange {	Line 1167 sub get_sigrange {
return ($sig_ubound,$sig_lbound);	return ($sig_ubound,$sig_lbound);
}	}

	sub format_prior_response_string {
	my ($mode,$answer) =@_;
	return '<span class="LC_prior_string">'.
	&HTML::Entities::encode($answer,'"<>&').'</span>';
	}

sub start_stringresponse {	sub start_stringresponse {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result;	my $result;
my $id = &Apache::response::start_response($parstack,$safeeval);	my $id = &Apache::response::start_response($parstack,$safeeval);
	undef(%answer);
if ($target eq 'meta') {	if ($target eq 'meta') {
$result=&Apache::response::meta_package_write('stringresponse');	$result=&Apache::response::meta_package_write('stringresponse');
} elsif ($target eq 'edit') {	} elsif ($target eq 'edit') {
Line 920 sub start_stringresponse {	Line 1189 sub start_stringresponse {
['re','Regular Expression']],$token);	['re','Regular Expression']],$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);
	$result.=&Apache::edit::text_arg('Pre-Processor Subroutine:','preprocess',
	$token,10);
$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,'answer',	$safeeval,'answer',
'type','answerdisplay');	'type','answerdisplay','preprocess');
if ($constructtag) {	if ($constructtag) {
$result = &Apache::edit::rebuild_tag($token);	$result = &Apache::edit::rebuild_tag($token);
$result.=&Apache::edit::handle_insert();	$result.=&Apache::edit::handle_insert();
Line 970 sub end_stringresponse {	Line 1241 sub end_stringresponse {
my $response = &Apache::response::getresponse();	my $response = &Apache::response::getresponse();
if ( $response =~ /[^\s]/) {	if ( $response =~ /[^\s]/) {
my %previous = &Apache::response::check_for_previous($response,	my %previous = &Apache::response::check_for_previous($response,
$part,$id);	$part,$id,
	undef,$type);
&Apache::lonxml::debug("submitted a $response<br>\n");	&Apache::lonxml::debug("submitted a $response<br>\n");
&Apache::lonxml::debug($$parstack[-1] . "\n<br>");	&Apache::lonxml::debug($$parstack[-1] . "\n<br>");
$Apache::lonhomework::results{"resource.$part.$id.submission"}=	$Apache::lonhomework::results{"resource.$part.$id.submission"}=
Line 984 sub end_stringresponse {	Line 1256 sub end_stringresponse {
# $answer=$token->[2]->{'answer'};	# $answer=$token->[2]->{'answer'};
# }	# }
${$safeeval->varglob('LONCAPA::response')}=$response;	${$safeeval->varglob('LONCAPA::response')}=$response;
	my $preprocess=&Apache::lonxml::get_param('preprocess',$parstack,$safeeval);
	$preprocess=~s/^\&//;
	if (defined($preprocess)) {
	&Apache::run::run('$LONCAPA::response=&'.$preprocess.'($LONCAPA::response);',$safeeval);
	}
$result = &Apache::run::run('if ($LONCAPA::response=~m'.$answer.') { return 1; } else { return 0; }',$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 $response");
&Apache::lonxml::debug("current $answer");	&Apache::lonxml::debug("current $answer");
$ad = ($result) ? 'APPROX_ANS' : 'INCORRECT';	$ad = ($result) ? 'APPROX_ANS' : 'INCORRECT';
} else {	} else {
my @args = ('type');	my @args = ('type','preprocess');
my $args_ref = &setup_capa_args($safeeval,$parstack,	my $args_ref = &setup_capa_args($safeeval,$parstack,
\@args,$response);	\@args,$response);
	if ($$args_ref{'type'} eq '') {
	$$args_ref{'type'} = 'ci';
	}
&add_in_tag_answer($parstack,$safeeval);	&add_in_tag_answer($parstack,$safeeval);
my (@final_awards,@final_msgs,@names);	my (@final_awards,@final_msgs,@names,%ansstring);
foreach my $name (keys(%answer)) {	foreach my $name (keys(%answer)) {
&Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} }));	&Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} }));
${$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=dclone($answer{$name});	${$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=dclone($answer{$name});
my ($result, @msgs)=&Apache::run::run("&caparesponse_check_list()",$safeeval);	my ($result, @msgs)=&Apache::run::run("&caparesponse_check_list()",$safeeval);
	if ($$args_ref{'type'} =~ /^c[si]$/) {
	$ansstring{$name} = pop(@msgs);
	my $control_chars_removed = pop(@msgs);
	my $error = pop(@msgs);
	if (($error ne '') \|\|
	($control_chars_removed)) {
	my ($symb,$courseid,$sdomain,$sname) =
	&Apache::lonnet::whichuser();
	if ($control_chars_removed) {
	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));	&Apache::lonxml::debug('msgs are'.join(':',@msgs));
my ($awards)=split(/:/,$result);	my ($awards)=split(/:/,$result);
my (@awards) = split(/,/,$awards);	my (@awards) = split(/,/,$awards);
Line 1009 sub end_stringresponse {	Line 1313 sub end_stringresponse {
push(@names,$name);	push(@names,$name);
&Apache::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n");	&Apache::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n");
}	}
my ($ad, $msg, $name) =	($ad, $msg, my $name) =
&Apache::inputtags::finalizeawards(\@final_awards,	&Apache::inputtags::finalizeawards(\@final_awards,
\@final_msgs,	\@final_msgs,
\@names,1);	\@names,1);
}	if (keys(%ansstring) > 0) {
if ($Apache::lonhomework::type eq 'survey' &&	$Apache::lonhomework::results{"resource.$part.$id.answerstring"} = &Apache::lonnet::hash2str(%ansstring);
($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::response::handle_previous(\%previous,$ad);
$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$ad;	$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$ad;
$Apache::lonhomework::results{"resource.$part.$id.awardmsg"}=$msg;	$Apache::lonhomework::results{"resource.$part.$id.awardmsg"}=$msg;
Line 1044 sub end_stringresponse {	Line 1382 sub end_stringresponse {
if ($target eq 'answer') {	if ($target eq 'answer') {
$result.=&Apache::response::answer_part('stringresponse',	$result.=&Apache::response::answer_part('stringresponse',
$element);	$element);
	if ($env{'form.grade_retrieveanswers'}) {
	$env{'form.grade_answers.resource.'.$part.'.'.$id} = $element;
	}
} elsif ($target eq 'analyze') {	} elsif ($target eq 'analyze') {
push (@{ $Apache::lonhomework::analyze{"$part.$id.answer"}{$name}[$i] },	push (@{ $Apache::lonhomework::analyze{"$part.$id.answer"}{$name}[$i] },
$element);	$element);
Line 1082 sub end_stringresponse {	Line 1423 sub end_stringresponse {
}	}
} elsif ($target eq 'edit') {	} elsif ($target eq 'edit') {
$result.='</td></tr>'.&Apache::edit::end_table;	$result.='</td></tr>'.&Apache::edit::end_table;
	} elsif ($target eq 'web' \|\| $target eq 'tex') {
	&Apache::response::setup_prior_tries_hash(\&format_prior_response_string);
}	}
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 = &Apache::response::repetition();
	&Apache::lonxml::increment_counter($repetition,"$part.$id");
	if ($target eq 'analyze') {
	&Apache::lonhomework::set_bubble_lines();
	}
}	}
&Apache::response::end_response;	&Apache::response::end_response;
return $result;	return $result;

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

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.

Removed from v.1.198.2.2
changed lines
	Added in v.1.256