loncom/homework/response.pm - view

File: [LON-CAPA] / loncom / homework / response.pm
Revision 1.250: download - view: text, annotated - select for diffs
Tue Oct 29 03:22:10 2024 UTC (2 weeks ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD

- Bug 6995
  Space (ascii 32) is not supported as a delimiter after \verb for TeX Live
  2020 and later. * (ascii 42) should also not be used as a delimiter.

# The LearningOnline Network with CAPA # various response type definitons response definition # # $Id: response.pm,v 1.250 2024/10/29 03:22:10 raeburn 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/ # =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; use strict; use Apache::lonlocal; use Apache::lonnet; use Apache::inputtags(); use Apache::lonmaxima(); use Apache::lonr(); use Apache::lontexconvert(); BEGIN { &Apache::lonxml::register('Apache::response',('responseparam','parameter','dataresponse','customresponse','mathresponse')); } sub start_response { my ($parstack,$safeeval)=@_; my $id = &Apache::lonxml::get_id($parstack,$safeeval); if ($#Apache::inputtags::import > -1) { &Apache::lonxml::debug("Turning :$id: into"); $id = join('_',@Apache::inputtags::import).'_'.$id; &Apache::lonxml::debug("New :$id:"); } push (@Apache::inputtags::response,$id); push (@Apache::inputtags::responselist,$id); @Apache::inputtags::inputlist=(); if ($Apache::inputtags::part eq '' && !$Apache::lonhomework::ignore_response_errors) { &Apache::lonxml::error(&HTML::Entities::encode(&mt("Found a <*response> outside of a <part> in a <part>ed problem"),'<>&"')); } if ($Apache::inputtags::response_with_no_part && $Apache::inputtags::part ne '0') { &Apache::lonxml::error(&HTML::Entities::encode(&mt("<*response>s are both inside of <part> and outside of <part>, this is not a valid problem, errors in grading may occur."),'<>&"').'<br />'); } if ($Apache::inputtags::part eq '0') { $Apache::inputtags::response_with_no_part=1; } return $id; } sub end_response { #pop @Apache::inputtags::response; @Apache::inputtags::inputlist=(); return ''; } sub start_hintresponse { my ($parstack,$safeeval)=@_; my $id = &Apache::lonxml::get_id($parstack,$safeeval); push (@Apache::inputtags::hint,$id); push (@Apache::inputtags::hintlist,$id); push (@Apache::inputtags::paramstack,[%Apache::inputtags::params]); return $id; } sub end_hintresponse { pop @Apache::inputtags::hint; if (defined($Apache::inputtags::paramstack[-1])) { %Apache::inputtags::params= @{ pop(@Apache::inputtags::paramstack) }; } return ''; } my @randomseeds; sub pushrandomnumber { my $rand_alg=&Apache::lonnet::get_rand_alg(); if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' || $rand_alg eq '64bit2') { # do nothing } else { my @seed=&Math::Random::random_get_seed(); push(@randomseeds,\@seed); } &Apache::response::setrandomnumber(@_); } sub poprandomnumber { my $rand_alg=&Apache::lonnet::get_rand_alg(); if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' || $rand_alg eq '64bit2') { return; } my $seed=pop(@randomseeds); if ($seed) { &Math::Random::random_set_seed(@$seed); } else { &Apache::lonxml::error("Unable to restore random algorithm."); } } sub setrandomnumber { my ($ignore_id2,$target,$rndseed) = @_; if (!defined($rndseed)) { $rndseed=&Apache::structuretags::setup_rndseed(undef,$target); } if (!defined($rndseed)) { $rndseed=&Apache::lonnet::rndseed(); } &Apache::lonxml::debug("randseed $rndseed"); # $rndseed=unpack("%32i",$rndseed); my $rand_alg=&Apache::lonnet::get_rand_alg(); my ($rndmod,$rndmod2); my ($id1,$id2,$shift_amt); if ($Apache::lonhomework::parsing_a_problem) { $id1=$Apache::inputtags::part; if (defined($Apache::inputtags::response[-1])) { $id2=$Apache::inputtags::response[-1]; } $shift_amt=scalar(@Apache::inputtags::responselist); } elsif ($Apache::lonhomework::parsing_a_task) { $id1=&Apache::bridgetask::get_dim_id(); if (!$ignore_id2 && ref($Apache::bridgetask::instance{$id1})) { $id2=$Apache::bridgetask::instance{$id1}[-1]; $shift_amt=scalar(@{$Apache::bridgetask::instance{$id1}}); } else { $shift_amt=0; } } &Apache::lonxml::debug("id1: $id1, id2: $id2, shift_amt: $shift_amt"); if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' || $rand_alg eq '64bit2') { $rndmod=(&Apache::lonnet::numval($id1) << 10); if (defined($id2)) { $rndmod+=&Apache::lonnet::numval($id2); } } elsif ($rand_alg eq '64bit3') { $rndmod=(&Apache::lonnet::numval2($id1) << 10); if (defined($id2)) { $rndmod+=&Apache::lonnet::numval2($id2); } } elsif ($rand_alg eq '64bit4') { my $shift=(4*$shift_amt)%30; $rndmod=(&Apache::lonnet::numval3($id1) << (($shift+15)%30)); if (defined($id2)) { $rndmod+=(&Apache::lonnet::numval3($id2) << $shift ); } } else { ($rndmod,$rndmod2)=&Apache::lonnet::digest("$id1,$id2"); } if ($rndseed =~/([,:])/) { my $char=$1; use integer; my ($num1,$num2)=split(/\Q$char\E/,$rndseed); $num1+=$rndmod; $num2+= ((defined($rndmod2)) ? $rndmod2 : $rndmod); if($Apache::lonnet::_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } $rndseed=$num1.$char.$num2; } else { $rndseed+=$rndmod; if($Apache::lonnet::_64bit) { use integer; $rndseed=(($rndseed<<32)>>32); } } &Apache::lonxml::debug("randseed $rndmod $rndseed"); &Apache::lonnet::setup_random_from_rndseed($rndseed); return ''; } sub meta_parameter_write { my ($name,$type,$default,$display)=@_; my $partref=$Apache::inputtags::part; my $result='<parameter part="'.$Apache::inputtags::part.'"'; if (defined($Apache::inputtags::response[-1])) { $result.= ' id="'.$Apache::inputtags::response[-1].'"'; $partref.='_'.$Apache::inputtags::response[-1]; } $result.= ' name="'.$name.'"'. ' type="'.$type.'"'. (defined($default)?' default="'.$default.'"':''). (defined($display)?' display="'.$display.' [Part: '.$partref.']"':'') .'></parameter>' ."\n"; return $result; } sub meta_package_write { my $name=shift; my $result = '<parameter part="'.$Apache::inputtags::part.'"'; if(defined($Apache::inputtags::response[-1])) { $result.= ' id="'.$Apache::inputtags::response[-1].'"'; } $result.=' package="'.$name.'"></parameter>'."\n"; return $result; } sub meta_stores_write { my ($name,$type,$display)=@_; my $partref=$Apache::inputtags::part; my $result = '<stores part="'.$Apache::inputtags::part.'"'; if (defined($Apache::inputtags::response[-1])) { $result.= ' id="'.$Apache::inputtags::response[-1].'"'; $partref.='_'.$Apache::inputtags::response[-1]; } $result.= ' name="'.$name.'"'. ' type="'.$type.'"'. ' display="'.$display.' [Part: '.$partref.']"'. "></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 { return &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'); } sub meta_part_order { my ($type) = @_; if (@Apache::inputtags::partlist) { my @parts=@Apache::inputtags::partlist; unless ($type eq 'library') { shift(@parts); } return '<partorder>'.join(',',@parts).'</partorder>'."\n"; } elsif ($type eq 'library') { return '<partorder></partorder>'."\n"; } else { return '<partorder>0</partorder>'."\n"; } } sub meta_response_order { if (@Apache::inputtags::responselist) { return '<responseorder>'.join(',',@Apache::inputtags::responselist). '</responseorder>'."\n"; } } sub check_for_previous { my ($curresponse,$partid,$id,$last,$type) = @_; my %previous; $previous{'used'} = 0; my $questiontype = $Apache::lonhomework::type; my $curr_rndseed = $env{'form.'.$partid.'.rndseed'}; foreach my $key (sort(keys(%Apache::lonhomework::history))) { if ($key =~ /resource\.\Q$partid\E\.\Q$id\E\.submission$/) { if ( $last && $key =~ /^(\d+):/ ) { next if ($1 >= $last); } &Apache::lonxml::debug("Trying $key"); my $pastresponse=$Apache::lonhomework::history{$key}; if ($pastresponse eq $curresponse) { my $history; if ( $key =~ /^(\d+):/ ) { $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{'last'}='0'; push(@{ $previous{'version'} },$history); } 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{'last'}='1'; } $previous{'used'} = 1; 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'}:"); } 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); return %previous; } sub handle_previous { my ($previous,$ad)=@_; if ($$previous{'used'} && ($$previous{'award'} eq $ad) ) { if ($$previous{'last'}) { push(@Apache::inputtags::previous,'PREVIOUSLY_LAST'); push(@Apache::inputtags::previous_version,$$previous{'version'}); } 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_version,$$previous{'version'}); } } } sub view_or_modify { my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser(); my $myself=0; if ( ($name eq $env{'user.name'}) && ($domain eq $env{'user.domain'}) ) { $myself=1; } my $vgr=&Apache::lonnet::allowed('vgr',$courseid); my $mgr=&Apache::lonnet::allowed('vgr',$courseid); if ($mgr) { return "M"; } if ($vgr) { return "V"; } if ($myself) { return "V"; } return ''; } sub start_dataresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $id = &Apache::response::start_response($parstack,$safeeval); my $result; if ($target eq 'web') { $result = $token->[2]->{'display'}.':'; } elsif ($target eq 'meta') { $result = &Apache::response::meta_stores_write($token->[2]->{'name'}, $token->[2]->{'type'}, $token->[2]->{'display'}); $result .= &Apache::response::meta_package_write('dataresponse'); } return $result; } sub end_dataresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result; if ( $target eq 'web' ) { } elsif ($target eq 'grade' ) { if ( defined $env{'form.submitted'}) { my ($symb,$courseid,$domain,$name)=&Apache::lonnet::whichuser(); my $allowed=&Apache::lonnet::allowed('mgr',$courseid); if ($allowed) { &Apache::response::setup_params('dataresponse',$safeeval); my $partid = $Apache::inputtags::part; my $id = $Apache::inputtags::response['-1']; my $response = $env{'form.HWVAL_'.$id}; my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval); if ( $response =~ /[^\s]/) { $Apache::lonhomework::results{"resource.$partid.$id.$name"}=$response; $Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response; $Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}='SUBMITTED'; } } else { $result=&mt('Not Permitted to change values'); } } } &Apache::response::end_response; return $result; } sub start_customresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $id = &Apache::response::start_response($parstack,$safeeval); push(@Apache::lonxml::namespace,'customresponse'); my $result; @Apache::response::custom_answer=(); @Apache::response::custom_answer_type=(); &Apache::lonxml::register('Apache::response',('answer')); if ($target eq 'web') { if ( &Apache::response::show_answer() ) { my $answer = &Apache::lonxml::get_param('answerdisplay',$parstack, $safeeval); $Apache::inputtags::answertxt{$id}=[$answer]; } } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_start($target,$token); $result.=&Apache::edit::text_arg('String to display for answer:', 'answerdisplay',$token,'50'); $result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row(); } elsif ($target eq 'modified') { my $constructtag; $constructtag=&Apache::edit::get_new_args($token,$parstack, $safeeval,'answerdisplay'); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } } elsif ($target eq 'answer' || $target eq 'grade') { &Apache::response::reset_params(); } elsif ($target eq 'meta') { $result .= &Apache::response::meta_package_write('customresponse'); } return $result; } sub end_customresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result; my $part=$Apache::inputtags::part; my $id=$Apache::inputtags::response[-1]; if ( $target eq 'grade' && &Apache::response::submitted() ) { my $response = &Apache::response::getresponse(); if ($Apache::lonhomework::type eq 'exam' || &Apache::response::submitted('scantron')) { &Apache::response::scored_response($part,$id); } elsif ( $response =~ /[^\s]/ && $Apache::response::custom_answer_type[-1] eq 'loncapa/perl') { if (!$Apache::lonxml::default_homework_loaded) { &Apache::lonxml::default_homework_load($safeeval); } my %previous = &Apache::response::check_for_previous($response, $part,$id); $Apache::lonhomework::results{"resource.$part.$id.submission"}= $response; my $error; ${$safeeval->varglob('LONCAPA::customresponse_submission')}= $response; my ($award,$score) = &Apache::run::run('{ my $submission=$LONCAPA::customresponse_submission;'.$Apache::response::custom_answer[-1].'}',$safeeval); if (!&Apache::inputtags::valid_award($award)) { $error = $award; $award = 'ERROR'; } if (($award eq 'INCORRECT') || ($award eq 'APPROX_ANS') || ($award eq 'EXACT_ANS') || ($award eq 'ASSIGNED_SCORE')) { 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::lonhomework::results{"resource.$part.$id.awarddetail"}= $award; if ($award eq 'ASSIGNED_SCORE') { $Apache::lonhomework::results{"resource.$part.$id.awarded"}=1.0*$score; } if ($error) { $Apache::lonhomework::results{"resource.$part.$id.awardmsg"}= $error; } } } elsif ( $target eq 'answer') { $result = &Apache::response::answer_header('customresponse'); my $answer = &Apache::lonxml::get_param('answerdisplay',$parstack, $safeeval); if ($env{'form.answer_output_mode'} ne 'tex') { $answer = '<b>'.$answer.'</b>'; } $result .= &Apache::response::answer_part('customresponse',$answer); $result .= &Apache::response::answer_footer('customresponse'); } if ($target eq 'web') { &setup_prior_tries_hash(\&format_prior_response_custom); } if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || $target eq 'tex' || $target eq 'analyze') { my $repetition = &repetition(); &Apache::lonxml::increment_counter($repetition,"$part.$id"); if ($target eq 'analyze') { $Apache::lonhomework::analyze{"$part.$id.type"} = 'customresponse'; &Apache::lonhomework::set_bubble_lines(); } } if ($target eq 'web') { &setup_prior_tries_hash(\&format_prior_response_math); } pop(@Apache::lonxml::namespace); pop(@Apache::response::custom_answer); pop(@Apache::response::custom_answer_type); &Apache::lonxml::deregister('Apache::response',('answer')); &Apache::response::end_response(); return $result; } sub format_prior_response_custom { my ($mode,$answer) =@_; if (ref($answer) eq 'ARRAY') { $answer = '('.join(', ', @{ $answer }).')'; } return '<span class="LC_prior_custom">'. &HTML::Entities::encode($answer,'"<>&').'</span>'; } sub start_mathresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $id = &Apache::response::start_response($parstack,$safeeval); push(@Apache::lonxml::namespace,'mathresponse'); my $result; @Apache::response::custom_answer=(); @Apache::response::custom_answer_type=(); &Apache::lonxml::register('Apache::response',('answer')); if ($target eq 'web') { if ( &Apache::response::show_answer() ) { my $answer = &Apache::lonxml::get_param('answerdisplay',$parstack, $safeeval); $Apache::inputtags::answertxt{$id}=[$answer]; } } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_start($target,$token); $result.=&Apache::edit::text_arg('String to display for answer:', 'answerdisplay',$token,'50'); $result.=&Apache::edit::select_arg('Algebra System:', 'cas', ['maxima','R'], $token); $result.=&Apache::edit::text_arg('Argument Array:', '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(); } elsif ($target eq 'modified') { my $constructtag; $constructtag=&Apache::edit::get_new_args($token,$parstack, $safeeval,'answerdisplay','cas','args','libraries'); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } } elsif ($target eq 'answer' || $target eq 'grade') { &Apache::response::reset_params(); } elsif ($target eq 'meta') { $result .= &Apache::response::meta_package_write('mathresponse'); } return $result; } sub end_mathresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result; my $part=$Apache::inputtags::part; my $id=$Apache::inputtags::response[-1]; if ( $target eq 'grade' && &Apache::response::submitted() ) { my $response = &Apache::response::getresponse(); if ( $response =~ /[^\s]/ ) { if (!$Apache::lonxml::default_homework_loaded) { &Apache::lonxml::default_homework_load($safeeval); } my %previous = &Apache::response::check_for_previous($response, $part,$id); $Apache::lonhomework::results{"resource.$part.$id.submission"}= $response; my $error; my $award; my $cas = &Apache::lonxml::get_param('cas',$parstack,$safeeval); if ($cas eq 'maxima') { my $args = [&Apache::lonxml::get_param_var('args',$parstack,$safeeval)]; $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)) { $error = $award; $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::lonhomework::results{"resource.$part.$id.awarddetail"}= $award; if ($error) { $Apache::lonhomework::results{"resource.$part.$id.awardmsg"}= $error; } } } pop(@Apache::lonxml::namespace); pop(@Apache::response::custom_answer); pop(@Apache::response::custom_answer_type); &Apache::lonxml::deregister('Apache::response',('answer')); &Apache::response::end_response(); return $result; } sub format_prior_response_math { my ($mode,$answer) =@_; return '<span class="LC_prior_math">'. &HTML::Entities::encode($answer,'"<>&').'</span>'; } sub implicit_multiplication { my ($expression)=@_; # Escape scientific notation, so 3e8 does not become 3*e*8 # 3e8 -> 3&8; 3e-8 -> 3&-8; 3E+8 -> e&+8 $expression=~s/(\d+)e([\+\-]*\d+)/$1\&$$2$/gsi; # 3x10^8 -> 3&8; 3*10^-8 -> 3&-8 $expression=~s/(\d+)(?:x|\*)10(?:\^|\*\*)([\+\-]*\d+)/$1\&$$2$/gsi; # Fill in multiplication signs # a b -> a*b;3 b -> 3*b;3 4 -> 3*4 $expression=~s/([A-Za-z0-9])\s+(?=[A-Za-z0-9])/$1\*/gs; # )( -> )*(; ) ( -> )*( $expression=~s/\)\s*$/$\*$/gs; # 3a -> 3*a; 3( -> 3*(; 3 ( -> 3*(; 3A -> 3*A $expression=~s/(\d)\s*([a-zA-Z\(])/$1\*$2/gs; # a ( -> a*( $expression=~s/([A-Za-z0-9])\s+\(/$1\*\(/gs; # )a -> )*a; )3 -> )*3; ) 3 -> )*3 $expression=~s/$\s*([A-Za-z0-9])/\)\*$1/gs; # 3&8 -> 3e8; 3&-4 -> 3e-4 $expression=~s/(\d+)\&$([\+\-]*\d+)$/$1e$2/gs; return $expression; } sub start_answer { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result; push(@Apache::response::custom_answer, &Apache::lonxml::get_all_text_unbalanced("/answer",$parser)); push(@Apache::response::custom_answer_type, lc(&Apache::lonxml::get_param('type',$parstack,$safeeval))); $Apache::response::custom_answer_type[-1] =~ s/\s+//g; if ($target eq "edit" ) { $result=&Apache::edit::tag_start($target,$token,'Answer algorithm'); $result.=&Apache::edit::editfield($token->[1], $Apache::response::custom_answer[-1], '',80,4); } elsif ( $target eq "modified" ) { $result=$token->[4].&Apache::edit::modifiedfield('/answer',$parser); } return $result; } sub end_answer { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; if ($target eq 'edit' ) { return &Apache::edit::end_table(); } } sub decide_package { my ($tagstack)=@_; my $package; if ($$tagstack[-1] eq 'parameter') { $package='part'; } else { my $i=-1; while (defined($$tagstack[$i])) { if ($$tagstack[$i] =~ /(response|hint)$/) { $package=$$tagstack[$i]; last; } $i--; } } return $package; } sub start_responseparam { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result=''; if ($target eq 'meta') { $result = &meta_parameter_write($token->[2]->{'name'}, $token->[2]->{'type'}, $token->[2]->{'default'}, $token->[2]->{'description'}); } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_start($target,$token); my $optionlist; my $package=&decide_package($tagstack); foreach my $key (sort(keys(%Apache::lonnet::packagetab))) { if ($key =~ /^\Q$package\E&(.*)&display$/) { $optionlist.='<option value="'.$1.'">'. $Apache::lonnet::packagetab{$key}.'</option>'; } } if (defined($optionlist)) { $result.=&mt('Use template:').' <select name="'. &Apache::edit::html_element_name('parameter_package').'">'. '<option value=""></option>'.$optionlist.'</select><br />'; } $result.=&Apache::edit::text_arg('Name:','name',$token). &Apache::edit::text_arg('Type:','type',$token). &Apache::edit::text_arg('Description:','description',$token). &Apache::edit::text_arg('Default:','default',$token). "</td></tr>"; $result.=&Apache::edit::end_table; } elsif ($target eq 'modified') { my $constructtag=&Apache::edit::get_new_args($token,$parstack, $safeeval,'name','type', 'description','default'); my $element=&Apache::edit::html_element_name('parameter_package'); if (defined($env{"form.$element"}) && $env{"form.$element"} ne '') { my $name=$env{"form.$element"}; my $tag=&decide_package($tagstack); $token->[2]->{'name'}=$name; $token->[2]->{'type'}= $Apache::lonnet::packagetab{"$tag&$name&type"}; $token->[2]->{'description'}= $Apache::lonnet::packagetab{"$tag&$name&display"}; $token->[2]->{'default'}= $Apache::lonnet::packagetab{"$tag&$name&default"}; $token->[3] = ['name','type','description','default']; $constructtag=1; } if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } } elsif ($target eq 'grade' || $target eq 'answer' || $target eq 'web' || $target eq 'tex' || $target eq 'analyze' ) { if (($env{'request.state'} eq 'construct') || ($env{'request.noversionuri'} =~ m{^\Q/res/adm/includes/templates/\E[^/]+\.problem$})) { my $name =&Apache::lonxml::get_param('name',$parstack,$safeeval); my $default=&Apache::lonxml::get_param('default',$parstack, $safeeval); if ($name) {$Apache::inputtags::params{$name}=$default;} } } return $result; } sub end_responseparam { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; if ($target eq 'edit') { return ('','no'); } return ''; } sub start_parameter { return &start_responseparam(@_); } sub end_parameter { return &end_responseparam(@_); } sub reset_params { %Apache::inputtags::params=(); } sub setup_params { my ($tag,$safeeval) = @_; if (($env{'request.state'} eq 'construct') || ($env{'request.noversionuri'} =~ m{^\Q/res/adm/includes/templates/\E[^/]+\.problem$})) { return; } my %paramlist=(); foreach my $key (keys(%Apache::lonnet::packagetab)) { if ($key =~ /^\Q$tag\E/) { my ($package,$name) = split(/&/,$key); $paramlist{$name}=1; } } foreach my $key (keys(%paramlist)) { my $entry= 'resource.'.$Apache::inputtags::part; if (defined($Apache::inputtags::response[-1])) { $entry.='_'.$Apache::inputtags::response[-1]; } $entry.='.'.$key; &Apache::lonxml::debug("looking for $entry"); my $value = &Apache::lonnet::EXT("$entry"); &Apache::lonxml::debug("$key has value :$value:"); if ($value eq 'con_lost' || $value =~ /^error:/) { &Apache::lonxml::debug("using nothing"); $Apache::inputtags::params{$key}=''; } else { my $string="{return qq\0".$value."\0}"; my $newvalue=&Apache::run::run($string,$safeeval,1); if (defined($newvalue)) { $value=$newvalue; } $Apache::inputtags::params{$key}=$value; } } } { my @answer_bits; my $need_row_start; sub answer_header { my ($type,$increment,$rows) = @_; my $result; if ($env{'form.answer_output_mode'} eq 'tex') { undef(@answer_bits); my $bit; if ($Apache::lonhomework::type eq 'exam') { $bit = ($Apache::lonxml::counter+$increment).') '; } else { $bit .= ' '.&mt('Answer for Part: [_1]', '\verb|'.$Apache::inputtags::part.'|').' '; } push(@answer_bits,$bit); } else { my $td = '<td '.(defined($rows)?'rowspan="'.$rows.'"':'').'>'; $result = '<table border="1"><tr>'; if ($Apache::lonhomework::type eq 'exam') { $result .= $td.($Apache::lonxml::counter+$increment). ')</td>'; } else { $result .= $td.&mt('Answer for Part: [_1]', $Apache::inputtags::part).'</td>'; } $result .= "\n"; $need_row_start = 0; } return $result; } sub next_answer { my ($type) = @_; my $result; if ($env{'form.answer_output_mode'} eq 'tex') { # FIXME ... need to do something with tex mode } else { $result .= "</tr>"; $need_row_start = 1; } return $result; } sub answer_part { my ($type,$answer,$args) = @_; my $result; if ($env{'form.answer_output_mode'} eq 'tex') { if (!$args->{'no_verbatim'}) { my $to_use='|'; foreach my $value (33..41,43..126) { my $char=pack('c',$value); if ($answer !~ /\Q$char\E/) { $to_use=$char; last; } } my $fullanswer=$answer; $answer=''; foreach my $element (split(/[\;]/,$fullanswer)) { if ($element ne '') { $answer.= '\verb'.$to_use.$element.$to_use.' \newline'; } } } if ($answer ne '') { push(@answer_bits,$answer); } } else { if ($need_row_start) { $result .= '<tr>'; $need_row_start = 0; } $result .= '<td>'.$answer.'</td>'; } return $result; } sub answer_footer { my ($type) = @_; my $result; if ($env{'form.answer_output_mode'} eq 'tex') { $result = ' \vskip 0 mm \noindent \begin{tabular}{|p{1.5cm}|p{6.8cm}|}\hline '; $result .= $answer_bits[0].'&\vspace*{-4mm}\begin{itemize}'; for (my $i=1;$i<=$#answer_bits;$i++) { $result.='\item '.$answer_bits[$i].'\vspace*{-7mm}'; } $result .= ' \end{itemize} \\\\ \hline \end{tabular} \vskip 0 mm '; } else { if (!$need_row_start) { $result .= '</tr>'; } $result .= '</table>'; } return $result; } } sub showallfoils { if (defined($env{'form.showallfoils'})) { my ($symb)=&Apache::lonnet::whichuser(); if (($env{'request.state'} eq 'construct') || ($env{'user.adv'} && $symb eq '') || ($Apache::lonhomework::viewgrades) ) { 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; } =pod =item &getresponse(); Retreives the current submitted response, helps out in the case of scantron mode. Returns either the exact text of the submission, or a bubbled response converted to something usable. Optional Arguments: $offset - (defaults to 1) if a problem has more than one bubble response, pass in the number of the bubble wanted, (the first bubble associated with a problem has an offset of 1, the second bubble is 2 $resulttype - undef -> a number between 0 and 25 'A is 1' -> a number between 1 and 26 'letter' -> a letter between 'A' and 'Z' $lines - undef problem only needs a single line of bubbles. nonzero Problem wants the first nonempty response in $lines lines of bubbles. $bubbles_per_line - Must be provided if lines is defined.. number of bubbles on a line. =cut sub getresponse { my ($offset,$resulttype, $lines, $bubbles_per_line)=@_; my $formparm='form.HWVAL_'.$Apache::inputtags::response['-1']; my $response; if (!defined($offset)) { $offset=1; } else { $formparm.=":$offset"; } if (!defined($lines)) { $lines = 1; } my %let_to_num=('A'=>0,'B'=>1,'C'=>2,'D'=>3,'E'=>4,'F'=>5,'G'=>6,'H'=>7, 'I'=>8,'J'=>9,'K'=>10,'L'=>11,'M'=>12,'N'=>13,'O'=>14, 'P'=>15,'Q'=>16,'R'=>17,'S'=>18,'T'=>19,'U'=>20,'V'=>21, 'W'=>22,'X'=>23,'Y'=>24,'Z'=>25); if ($env{'form.submitted'} eq 'scantron') { my $part = $Apache::inputtags::part; my $id = $Apache::inputtags::response[-1]; my $line; my $startline = $env{'form.scantron_questnum_start.'.$part.'.'.$id}; if (!$startline) { $startline = $Apache::lonxml::counter; } for ($line = 0; $line < $lines; $line++) { my $theline = $startline+$offset-1+$line; $response = $env{"scantron.$theline.answer"}; if ((defined($response)) && ($response ne "") && ($response ne " ")) { last; } } # save bubbled letter for later $Apache::lonhomework::results{"resource.$part.$id.scantron"}.= $response; if ($resulttype ne 'letter') { $response = $let_to_num{$response}; if ($resulttype eq 'A is 1') { if ($response ne "") { $response = $response+1; } } if ($response ne "") { $response += $line * $bubbles_per_line; } } else { if ($response ne "") { my $raw = $response; $response = chr(ord($response) + $line * $bubbles_per_line); } } } else { $response = $env{$formparm}; } # # If we have a nonempty answer, correct the numeric value # of the answer for the line on which it was found. # return $response; } =pod =item &repetition(); In scalar context: 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 sub repetition { my $id = $Apache::inputtags::part; my $weight = &Apache::lonnet::EXT("resource.$id.weight"); if (!defined($weight) || ($weight eq '')) { $weight=1; } 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 $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; } =pod =item &scored_response(); Sets the results hash elements resource.$part_id.$response_id.awarded - to the floating point number between 0 and 1 that was awarded on the bubbled input resource.$part_id.$response_id.awarddetail - to 'ASSIGNED_SCORE' Returns the number of bubble sheet lines that were used (and likely need to be passed to &Apache::lonxml::increment_counter() Arguments $part_id - id of the part to grade $response_id - id of the response to grade =cut sub scored_response { my ($part,$id)=@_; 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; for (my $i=0;$i<$repetition;$i++) { # A is 1, B is 2, etc. my $increase=&Apache::response::getresponse($i+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"); if (!defined($weight) || $weight eq '' || $weight eq 0) { $weight = 1; } my $pcr=$score/$weight; $Apache::lonhomework::results{"resource.$part.$id.awarded"}=$pcr; $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}= 'ASSIGNED_SCORE'; return $repetition; } sub whichorder { my ($max,$randomize,$showall,$hash,$rndseed)=@_; #&Apache::lonxml::debug("man $max randomize $randomize"); my @names; if (ref($hash->{'names'}) eq 'ARRAY') { @names = @{$hash->{'names'}}; } return if (!@names); my @whichopt =(); my (%top,@toplist,%bottom,@bottomlist); if (!($showall || ($randomize eq 'no'))) { my $current=0; foreach my $name (@names) { $current++; if ($$hash{"$name.location"} eq 'top') { $top{$name}=$current; } elsif ($$hash{"$name.location"} eq 'bottom') { $bottom{$name}=$current; } } } my $topcount=0; my $bottomcount=0; while (((scalar(@whichopt)+$topcount+$bottomcount) < $max || $showall) && ($#names > -1)) { #&Apache::lonxml::debug("Have $#whichopt max is $max"); my $aopt; if ($showall || ($randomize eq 'no')) { $aopt=0; } else { $aopt=int(&Math::Random::random_uniform() * ($#names+1)); } #&Apache::lonxml::debug("From $#whichopt $max $#names elms, picking $aopt"); $aopt=splice(@names,$aopt,1); #&Apache::lonxml::debug("Picked $aopt"); if ($top{$aopt}) { $toplist[$top{$aopt}]=$aopt; $topcount++; } elsif ($bottom{$aopt}) { $bottomlist[$bottom{$aopt}]=$aopt; $bottomcount++; } else { push (@whichopt,$aopt); } } for (my $i=0;$i<=$#toplist;$i++) { if ($toplist[$i]) { unshift(@whichopt,$toplist[$i]) } } for (my $i=0;$i<=$#bottomlist;$i++) { if ($bottomlist[$i]) { push(@whichopt,$bottomlist[$i]) } } return @whichopt; } sub show_answer { my $part = $Apache::inputtags::part; my $award = $Apache::lonhomework::history{"resource.$part.solved"}; my $status = $Apache::inputtags::status[-1]; my $canshow = 0; if ($award =~ /^correct/) { 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 { my ($shown,$attrs)=@_; my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]"; foreach my $name (@{ $Apache::response::foilgroup{'names'} }) { if (defined($Apache::lonhomework::analyze{"$part_id.foil.value.$name"})) { next; } push (@{ $Apache::lonhomework::analyze{"$part_id.foils"} },$name); foreach my $attr (@$attrs) { $Apache::lonhomework::analyze{"$part_id.foil.".$attr.".$name"} = $Apache::response::foilgroup{"$name.".$attr}; } } push (@{ $Apache::lonhomework::analyze{"$part_id.shown"} }, @{ $shown }); } sub check_if_computed { my ($token,$parstack,$safeeval,$name)=@_; my $value = &Apache::lonxml::get_param($name,$parstack,$safeeval); if (ref($token->[2]) eq 'HASH' && $value ne $token->[2]{$name}) { my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]"; $Apache::lonhomework::analyze{"$part_id.answercomputed"} = 1; } } sub pick_foil_for_concept { my ($target,$attrs,$hinthash,$parstack,$safeeval)=@_; my @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 $name=$names[$pick]; push @{ $Apache::response::foilgroup{'names'} }, $name; foreach my $attr (@$attrs) { $Apache::response::foilgroup{"$name.".$attr} = $Apache::response::conceptgroup{"$name.".$attr}; } my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval); $Apache::response::foilgroup{"$name.concept"} = $concept; &Apache::lonxml::debug("Selecting $name in $concept"); my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]"; if ($target eq 'analyze') { push (@{ $Apache::lonhomework::analyze{"$part_id.concepts"} }, $concept); $Apache::lonhomework::analyze{"$part_id.concept.$concept"}= $Apache::response::conceptgroup{'names'}; foreach my $name (@{ $Apache::response::conceptgroup{'names'} }) { push (@{ $Apache::lonhomework::analyze{"$part_id.foils"} }, $name); foreach my $attr (@$attrs) { $Apache::lonhomework::analyze{"$part_id.foil.$attr.$name"}= $Apache::response::conceptgroup{"$name.$attr"}; } } } push(@{ $hinthash->{"$part_id.concepts"} },$concept); $hinthash->{"$part_id.concept.$concept"}= $Apache::response::conceptgroup{'names'}; } =pod =item get_response_param() Get a parameter associated with a problem. Parameters: $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 { my ($id,$name,$default)=@_; my $parameter; if ($env{'request.state'} eq 'construct' && defined($Apache::inputtags::params{$name})) { $parameter=$Apache::inputtags::params{$name}; } else { $parameter=&Apache::lonnet::EXT("resource.$id.$name"); } if (!defined($parameter) || $parameter eq '') { $parameter = $default; } return $parameter; } sub submitted { my ($who)=@_; # when scatron grading any submission is a submission if ($env{'form.submitted'} eq 'scantron') { return 1; } # if the caller only cared if this was a scantron submission if ($who eq 'scantron') { return 0; } # if the Submit Answer button for this particular part was pressed my $partid=$Apache::inputtags::part; if ($env{'form.submitted'} eq "part_$partid") { return 1; } if ($env{'form.submitted'} eq "yes" && defined($env{'form.submit_'.$partid})) { return 1; } # Submit All button on a .page was pressed if ($env{'form.all_submit'}) { return 1; } # otherwise no submission occurred return 0; } sub add_to_gradingqueue { my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser(); if ( $courseid eq '' || $symb eq '' || $env{'request.state'} eq 'construct' || $Apache::lonhomework::type ne 'problem') { return; } my %queue_info = ( 'type' => 'problem', 'time' => time); if (exists($Apache::lonhomework::history{"resource.0.checkedin.slot"})) { $queue_info{'slot'}= $Apache::lonhomework::history{"resource.0.checkedin.slot"}; } my $result=&Apache::bridgetask::add_to_queue('gradingqueue',\%queue_info); if ($result ne 'ok') { &Apache::lonxml::error("add_to_queue said $result"); } } =pod =item check_status() basically undef and 0 (both false) mean that they still have work to do and all true values mean that they can't do any more work 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 { my ($id)=@_; if (!defined($id)) { $id=$Apache::inputtags::part; } my $curtime=&Apache::lonnet::EXT('system.time'); my $opendate=&Apache::lonnet::EXT("resource.$id.opendate"); my $duedate=&Apache::lonhomework::due_date($id); my $answerdate=&Apache::lonnet::EXT("resource.$id.answerdate"); if ( $opendate && $curtime > $opendate && $duedate && $curtime > $duedate && $answerdate && $curtime > $answerdate) { return 3; } my $status=&Apache::lonnet::EXT("user.resource.resource.$id.solved"); 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; } my $maxtries=&Apache::lonnet::EXT("resource.$id.maxtries"); if ($maxtries eq '') { $maxtries=2; } my $curtries=&Apache::lonnet::EXT("user.resource.resource.$id.tries"); if ($curtries < $maxtries) { return 0; } return 2; } =pod =item setup_prior_tries_hash() Foreach each past .submission $func is called with 3 arguments - the mode to set things up for (currently always 'grade') - the stored .submission string - The expansion of $data $data is an array ref containing elements that are either - scalars that are other elements of the history hash to pass to $func - ref to data to be passed untouched to $func $questiontype is the questiontype (currently only passed in if randomizebytry. =cut sub setup_prior_tries_hash { my ($func,$data,$questiontype) = @_; my $part = $Apache::inputtags::part; my $id = $Apache::inputtags::response[-1]; foreach my $i (1..$Apache::lonhomework::history{'version'}) { my $partprefix = "$i:resource.$part"; my $sub_key = "$partprefix.$id.submission"; next if (!exists($Apache::lonhomework::history{$sub_key})); my $type_key = "$partprefix.type"; my $type = $Apache::lonhomework::history{$type_key}; my @other_data; if (ref($data) eq 'ARRAY') { foreach my $datum (@{ $data }) { if (ref($datum)) { push(@other_data,$datum); } else { 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 = &$func('grade', $Apache::lonhomework::history{$sub_key}, \@other_data); if (defined($output)) { $Apache::inputtags::submission_display{$sub_key} = $output; } } } 1; __END__ =pod =cut