File:
[LON-CAPA] /
loncom /
homework /
caparesponse /
caparesponse.pm
Revision
1.117:
download - view:
text,
annotated -
select for diffs
Thu Oct 23 07:31:52 2003 UTC (20 years, 6 months ago) by
albertel
Branches:
MAIN
CVS tags:
HEAD
- implements the ability to specify incorrect answers fr bubble mode,
supports overspecifying and exactly specifying the correct number of answers
(in the underspecified mode it currently punts and ignores the incorrect, ideas on what to do are apprec
iated)
- supports a number of bubbles option
# The LearningOnline Network with CAPA
# caparesponse definition
#
# $Id: caparesponse.pm,v 1.117 2003/10/23 07:31:52 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::caparesponse;
use strict;
use capa;
BEGIN {
&Apache::lonxml::register('Apache::caparesponse',('caparesponse','numericalresponse','stringresponse','formularesponse'));
}
sub start_numericalresponse {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
my $id = &Apache::response::start_response($parstack,$safeeval);
my $result;
if ($target eq 'edit') {
$result.=&Apache::edit::tag_start($target,$token);
$result.=&Apache::edit::text_arg('Answer:','answer',$token);
$result.=&Apache::edit::text_arg('Incorrect Answers:','incorrect',
$token);
if ($token->[1] eq 'numericalresponse') {
$result.=&Apache::edit::text_arg('Unit:','unit',$token,5).
&Apache::loncommon::help_open_topic('Physical_Units');
$result.=&Apache::edit::text_arg('Format:','format',$token,4).
&Apache::loncommon::help_open_topic('Numerical_Response_Format');
} elsif ($token->[1] eq 'stringresponse') {
$result.=&Apache::edit::select_arg('Type:','type',
[['cs','Case Sensitive'],['ci','Case Insensitive'],
['mc','Case Insensitive, Any Order']],$token);
} elsif ($token->[1] eq 'formularesponse') {
$result.=&Apache::edit::text_arg('Sample Points:','samples',
$token,40).
&Apache::loncommon::help_open_topic('Formula_Response_Sampling');
}
$result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row();
} elsif ($target eq 'modified') {
my $constructtag;
if ($token->[1] eq 'numericalresponse') {
$constructtag=&Apache::edit::get_new_args($token,$parstack,
$safeeval,'answer',
'incorrect','unit',
'format');
} elsif ($token->[1] eq 'stringresponse') {
$constructtag=&Apache::edit::get_new_args($token,$parstack,
$safeeval,'answer',
'type');
} elsif ($token->[1] eq 'formularesponse') {
$constructtag=&Apache::edit::get_new_args($token,$parstack,
$safeeval,'answer',
'samples');
}
if ($constructtag) {
$result = &Apache::edit::rebuild_tag($token);
$result.=&Apache::edit::handle_insert();
}
} elsif ($target eq 'meta') {
$result=&Apache::response::meta_package_write('numericalresponse');
} elsif ($target eq 'answer' || $target eq 'grade') {
&Apache::response::reset_params();
} elsif ($target eq 'web') {
my $partid = $Apache::inputtags::part;
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") {
my $unit=&Apache::lonxml::get_param_var('unit',$parstack,
$safeeval);
if ($unit =~ /\S/) { $result.=" (in $unit) "; }
}
}
return $result;
}
sub end_numericalresponse {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $increment=1;
my $result = '';
if (!$Apache::lonxml::default_homework_loaded) {
&Apache::lonxml::default_homework_load($safeeval);
}
if ( $target eq 'grade' && defined($ENV{'form.submitted'})) {
&Apache::response::setup_params($$tagstack[-1]);
$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' &&
($$tagstack[-1] eq 'formularesponse' ||
$$tagstack[-1] eq 'stringresponse')) {
$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<br>\n");
&Apache::lonxml::debug($$parstack[-1] . "\n<br>");
if ($ENV{'form.submitted'} eq 'scantron') {
my $number_of_bubbles = &Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.numbubbles');
if (!$number_of_bubbles) { $number_of_bubbles=8; }
my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);
my (@answers)=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval);
my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack,$safeeval);
my @values=&make_numerical_bubbles($number_of_bubbles,$target,$answers[0],$formats[0],\@incorrect);
$response=$values[$response];
} else {
$response =~ s/\\/\\\\/g;
$response =~ s/\'/\\\'/g;
}
$Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response;
&Apache::lonxml::debug("current $response");
my $expression="&caparesponse_check_list('".$response."','".
$$parstack[-1];
my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffunit');
#no way to enter units, with radio buttons
if ($Apache::lonhomework::type eq 'exam' ||
lc($hideunit) eq "yes") {
$expression.=';my $unit=undef;';
}
foreach my $key (keys(%Apache::inputtags::params)) {
$expression.= ';my $'. #'
$key.'="'.$Apache::inputtags::params{$key}.'"';
}
if ($$tagstack[-1] eq 'formularesponse') {
$expression.=';my $type="fml";';
} elsif ($$tagstack[-1] eq 'numericalresponse') {
$expression.=';my $type="float";';
}
$expression.="');";
my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval);
&Apache::lonxml::debug('answer is'.join(':',@answer));
@{$safeeval->varglob('CAPARESPONSE_CHECK_LIST_answer')}=@answer;
$result = &Apache::run::run($expression,$safeeval);
my ($awards) = split /:/ , $result;
($ad) = &Apache::inputtags::finalizeawards(split /,/ , $awards);
&Apache::lonxml::debug("$expression");
&Apache::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n");
&Apache::response::handle_previous(\%previous,$ad);
$Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}=$ad;
$result='';
}
}
} elsif ($target eq 'web' || $target eq 'tex') {
my (@answers)=&Apache::lonxml::get_param_var('answer',$parstack,
$safeeval);
my $award = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
my $status = $Apache::inputtags::status['-1'];
if ( &Apache::response::show_answer() ) {
my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,
$safeeval);
my $unit=&Apache::lonxml::get_param_var('unit',$parstack,
$safeeval);
if ($target eq 'web') {
$result="<br />The correct answer is ";
}
for (my $i=0; $i <= $#answers; $i++) {
my $answer=$answers[$i];
my $format;
if ($#formats > 0) {
$format=$formats[$i];
} else {
$format=$formats[0];
}
my $formatted;
if ((defined($format)) && ($format ne '')) {
$format=~s/e/E/g;
&Apache::lonxml::debug("formatting with :$format: answer :$answer:");
$formatted=sprintf('%.'.$format,$answer).',';
} else {
&Apache::lonxml::debug("no format answer :$answer:");
$formatted="$answer,";
}
if ($target eq 'tex') {
$formatted='';
#$formatted=&Apache::lonxml::latex_special_symbols($formatted);
}
$result.=$formatted;
}
chop $result;
if ($target eq 'web') {
$result.=" $unit.<br />";
}
}
if ($Apache::lonhomework::type eq 'exam') {
my $number_of_bubbles = &Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.numbubbles');
if (!$number_of_bubbles) { $number_of_bubbles=8; }
my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,
$safeeval);
my $unit=&Apache::lonxml::get_param_var('unit',$parstack,
$safeeval);
my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack,$safeeval);
my @bubble_values=&make_numerical_bubbles($number_of_bubbles,
$target,$answers[0],
$formats[0],\@incorrect);
my @alphabet=('A'..'Z');
my $id=$Apache::inputtags::response[-1];
if ($target eq 'web') {
if ($$tagstack[-1] eq 'numericalresponse') {
if ($unit=~/\S/) {$result.=' (in '.$unit.')<br /><br />';}
$result.= '<table border="1"><tr>';
my $previous=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.$id.submission"};
for (my $ind=0;$ind<$number_of_bubbles;$ind++) {
my $checked='';
if ($previous eq $bubble_values[$ind]) {
$checked=" checked='on' ";
}
$result.='<td><input type="radio" name="HWVAL_'.$id.
'" value="'.$bubble_values[$ind].'" '.$checked
.' /><b>'.$alphabet[$ind].'</b>: '.
$bubble_values[$ind].'</td>';
}
$result.='</tr></table>';
} elsif ($$tagstack[-1] eq 'formularesponse') {
$result.= '<br /><br /><font color="red">
<textarea name="HWVAL_'.$id.'" rows="4" cols="50">
</textarea></font> <br /><br />';
}
} elsif ($target eq 'tex') {
if ((defined $unit) and ($unit=~/\S/) and ($Apache::lonhomework::type eq 'exam')) {
$result.=' \textit{(in} \verb|'.$unit.'|\textit{)} ';
}
if ($$tagstack[-1] eq 'numericalresponse') {
my ($celllength,$number_of_tables,@table_range)=
&get_table_sizes($formats[0],$number_of_bubbles);
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 \begin{tabular}{';
for (my $ind=0;$ind<$table_range[$j];$ind++) {
$result.='lp{'.$celllength.' mm}';
}
$result.='}';
for (my $ind=$cou;$ind<$cou+$table_range[$j];$ind++) {
$result.='\hskip -3 mm {\small \textbf{'.$alphabet[$ind].'}}$\bigcirc$\hskip -2 mm & {\small '.$bubble_values[$ind].'} ';
if ($ind != $cou+$table_range[$j]-1) {$result.=' & ';}
}
$cou += $table_range[$j];
$j++;
$result.='\\\\\end{tabular}\vskip 0 mm ';
}
$result.='\end{enumerate}';
} else {
$result.='\fbox{\fbox{\parbox{\textwidth-5mm}{\strut\\\\\strut\\\\\strut\\\\\strut\\\\}}}';
my $repetition = &Apache::response::repetition();
$result.='\begin{enumerate}';
for (my $i=0;$i<$repetition;$i++) {
$result.='\item[\textbf{'.($Apache::lonxml::counter+$i).'}.]\textit{Leave blank on scoring form}\vskip 0 mm';
}
$increment=$repetition;
$result.= '\end{enumerate}';
}
}
}
} elsif ($target eq 'edit') {
$result.='</td></tr>'.&Apache::edit::end_table;
} elsif ($target eq 'answer' || $target eq 'analyze') {
my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]";
if ($target eq 'analyze') {
push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id);
$Apache::lonhomework::analyze{"$part_id.type"} = $$tagstack[-1];
my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack,$safeeval);
push (@{ $Apache::lonhomework::analyze{"$part_id.incorrect"} }, @incorrect);
}
&Apache::response::setup_params($$tagstack[-1]);
my (@answers)=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval);
my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);
my $unit=&Apache::lonxml::get_param_var('unit',$parstack,$safeeval);
my $type=&Apache::lonxml::get_param('type',$parstack,$safeeval);
if ($target eq 'answer') {
$result.=&Apache::response::answer_header($$tagstack[-1]);
}
for(my $i=0;$i<=$#answers;$i++) {
my $ans=$answers[$i];
my $fmt=$formats[0];
if (@formats && $#formats) {$fmt=$formats[$i];}
my ($high,$low);
if ($Apache::inputtags::params{'tol'}) {
($high,$low)=&get_tolrange($ans,$Apache::inputtags::params{'tol'});
}
my ($sighigh,$siglow);
if ($Apache::inputtags::params{'sig'}) {
($sighigh,$siglow)=&get_sigrange($Apache::inputtags::params{'sig'});
}
if ($fmt && $$tagstack[-1] eq 'numericalresponse') {
$fmt=~s/e/E/g;
$ans = sprintf('%.'.$fmt,$ans);
if ($high) {
$high=sprintf('%.'.$fmt,$high);
$low =sprintf('%.'.$fmt,$low);
}
}
if ($target eq 'answer') {
if ($high && $$tagstack[-1] eq 'numericalresponse') { $ans.=' ['.$low.','.$high.']'; }
if ($sighigh && $$tagstack[-1] eq 'numericalresponse') {
if ($ENV{'form.answer_output_mode'} eq 'tex') {
$ans.= " Sig $siglow - $sighigh";
} else {
$ans.= " Sig <i>$siglow - $sighigh</i>";
}
}
$result.=&Apache::response::answer_part($$tagstack[-1],$ans);
} elsif ($target eq 'analyze') {
push (@{ $Apache::lonhomework::analyze{"$part_id.answer"} }, $ans);
if ($high) {
push (@{ $Apache::lonhomework::analyze{"$part_id.ans_high"} }, $high);
push (@{ $Apache::lonhomework::analyze{"$part_id.ans_low"} }, $low);
}
}
}
if (defined($unit) and ($unit ne '') and
$$tagstack[-1] eq 'numericalresponse') {
if ($target eq 'answer') {
if ($ENV{'form.answer_output_mode'} eq 'tex') {
$result.=&Apache::response::answer_part($$tagstack[-1],
" Unit: $unit ");
} else {
$result.=&Apache::response::answer_part($$tagstack[-1],
"Unit: <b>$unit</b>");
}
} elsif ($target eq 'analyze') {
push (@{ $Apache::lonhomework::analyze{"$part_id.unit"} }, $unit);
}
}
if ($type || $$tagstack[-1] eq 'stringresponse') {
my $string='Case Insensitive';
if ($type eq 'mc') {
$string='Multiple Choice';
} elsif ($type eq 'cs') {
$string='Case Sensitive';
} elsif ($type eq 'ci') {
$string='Case Insensitive';
} elsif ($type eq 'fml') {
$string='Formula';
}
if ($target eq 'answer') {
if ($ENV{'form.answer_output_mode'} eq 'tex') {
$result.=&Apache::response::answer_part($$tagstack[-1],
"$string");
} else {
$result.=&Apache::response::answer_part($$tagstack[-1],
"<b>$string</b>");
}
} elsif ($target eq 'analyze') {
push (@{ $Apache::lonhomework::analyze{"$part_id.str_type"} },
$type);
}
}
if ($$tagstack[-1] eq 'formularesponse' && $target eq 'answer') {
my $samples=&Apache::lonxml::get_param('samples',$parstack,$safeeval);
$result.=&Apache::response::answer_part($$tagstack[-1],$samples);
}
if ($target eq 'answer') {
$result.=&Apache::response::answer_footer($$tagstack[-1]);
}
}
if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' ||
$target eq 'tex' || $target eq 'analyze') {
&Apache::lonxml::increment_counter($increment);
}
&Apache::response::end_response;
return $result;
}
sub get_table_sizes {
my ($format,$number_of_bubbles)=@_;
my $max_val = 0;
if ($format=~m/^(\d+)E([^\d]*)(\d*)$/) {
$max_val=$1+$2+4;
} else {
$max_val=4;
}
$max_val = int(0.9*$ENV{'form.textwidth'}/(($max_val+6)*2));
my $celllength = 0.9*$ENV{'form.textwidth'}/$max_val-10;
my @table_range = ();
my $number_of_tables = int($number_of_bubbles/$max_val);
for (my $i=0;$i<$number_of_tables;$i++) {push @table_range,$max_val;}
if ($number_of_bubbles % $max_val != 0) {
$number_of_tables++;
push @table_range,($number_of_bubbles % $max_val);
}
return ($celllength,$number_of_tables,@table_range);
}
sub format_number {
my ($number,$format,$target)=@_;
my $ans;
if ($format ne '') {
$format=~s/e/E/g;
$ans = sprintf('%.'.$format,$number);
} else {
my $format = '';
#What is the number? (integer,decimal,floating point)
if ($number=~/^(\d*\.?\d*)(E|e)(\d*)$/) {
$format = '3e';
} elsif ($number=~/^(\d*)\.(\d*)$/) {
$format = '4f';
} elsif ($number=~/^(\d*)$/) {
$format = 'd';
}
$ans = sprintf('%.'.$format,$number);
}
if ($target eq 'tex') {
if ($ans =~ m/([0-9\.\-\+]+)E([0-9\-\+]+)/ ) {
my $number = $1;
my $power = $2;
$power=~s/^\+//;
$power=~s/^(-?)0+(\d+)//;
$ans=$number.'$\times 10^{'.$1.$2.'}$'; #'stupidemacs
}
}
return $ans;
}
sub make_numerical_bubbles {
my ($number_of_bubbles,$target,$answer,$format,$incorrect) =@_;
my @bubble_values = ();
&Apache::lonxml::debug("incorrect is $incorrect");
if (defined($incorrect) && ref($incorrect)) {
&Apache::lonxml::debug("inside ".(scalar(@$incorrect)+1 gt $number_of_bubbles));
if (scalar(@$incorrect)+1 >= $number_of_bubbles) {
&Apache::lonxml::debug("inside ".(scalar(@$incorrect)+1).":$number_of_bubbles");
&Apache::response::setrandomnumber();
my @rand_inc=&Math::Random::random_permutation(@$incorrect);
@bubble_values=@rand_inc[0..($number_of_bubbles-2)];
@bubble_values=sort {$a <=> $b} (@bubble_values,$answer);
&Apache::lonxml::debug("Answer was :$answer: returning :".$#bubble_values.": whih are :".join(':',@bubble_values));
return @bubble_values;
}
#FIXME what to do when not enough incorrects specified?
}
my @factors = (1.13,1.17,1.25,1.33,1.45); #default values of factors
my @powers = (1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0); #default values for powers
&Apache::response::setrandomnumber();
my $ind=&Math::Random::random_uniform_integer(1,0,$#powers);
my $power = $powers[$ind];
$ind=&Math::Random::random_uniform_integer(1,0,$#factors);
my $factor = $factors[$ind];
for ($ind=0;$ind<$number_of_bubbles;$ind++) {
$bubble_values[$ind] = $answer*($factor**($power-$powers[$#powers-$ind]));
$bubble_values[$ind] = &format_number($bubble_values[$ind],
$format,$target);
}
return @bubble_values;
}
sub get_tolrange {
my ($ans,$tol)=@_;
my ($high,$low);
if ($tol =~ /%$/) {
chop($tol);
my $change=$ans*($tol/100.0);
$high=$ans+$change;
$low=$ans-$change;
} else {
$high=$ans+$tol;
$low=$ans-$tol;
}
return ($high,$low);
}
sub get_sigrange {
my ($sig)=@_;
&Apache::lonxml::debug("Got a sig of :$sig:");
my $sig_lbound;
my $sig_ubound;
if ($sig eq '') {
$sig_lbound = 0; #SIG_LB_DEFAULT
$sig_ubound =15; #SIG_UB_DEFAULT
} else {
($sig_lbound,$sig_ubound) = split(/,/,$sig);
if (!$sig_lbound) {
$sig_lbound = 0; #SIG_LB_DEFAULT
$sig_ubound =15; #SIG_UB_DEFAULT
}
if (!$sig_ubound) { $sig_ubound=$sig_lbound; }
}
return ($sig_ubound,$sig_lbound);
}
sub start_stringresponse {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result;
if ($target eq 'meta') {
&Apache::response::start_response($parstack,$safeeval);
$result=&Apache::response::meta_package_write('stringresponse');
&Apache::response::end_response();
} else {
$result.=&start_numericalresponse(@_);
}
return $result;
}
sub end_stringresponse {
return end_numericalresponse(@_);
}
sub start_formularesponse {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result;
if ($target eq 'meta') {
&Apache::response::start_response($parstack,$safeeval);
$result=&Apache::response::meta_package_write('formularesponse');
&Apache::response::end_response();
} else {
$result.=&start_numericalresponse(@_);
}
return $result;
}
sub end_formularesponse {
return end_numericalresponse(@_);
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to caparesponse.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework / caparesponse