[BACK]Return to caparesponse.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework / caparesponse

Diff for /loncom/homework/caparesponse/caparesponse.pm between versions 1.141 and 1.201

version 1.141, 2004/03/12 21:06:19 version 1.201, 2006/12/14 04:59:51
Line 29 Line 29
 package Apache::caparesponse;  package Apache::caparesponse;
 use strict;  use strict;
 use capa;  use capa;
   use Safe::Hole;
   use Apache::lonmaxima();
 use Apache::lonlocal;  use Apache::lonlocal;
   use Apache::lonnet;
   use Storable qw(dclone);
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::caparesponse',('caparesponse','numericalresponse','stringresponse','formularesponse'));      &Apache::lonxml::register('Apache::caparesponse',('numericalresponse','stringresponse','formularesponse'));
   }
   
   my %answer;
   my $cur_name;
   my $tag_internal_answer_name = 'INTERNAL';
   
   sub start_answer {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $result;
       $cur_name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
       if ($cur_name =~ /^\s*$/) { $cur_name = $Apache::lonxml::curdepth; }
       my $type = &Apache::lonxml::get_param('type',$parstack,$safeeval);
       if (!defined($type) && $tagstack->[-2] eq 'answergroup') {
    $type = &Apache::lonxml::get_param('type',$parstack,$safeeval,-2);
       }
       if (!defined($type)) { $type = 'ordered' };
       $answer{$cur_name}= { 'type' => $type,
     'answers' => [] };
       return $result;
   }
   
   sub end_answer {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $result;
       undef($cur_name);
       return $result;
   }
   
   sub start_answergroup {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $result;
       return $result;
   }
   
   sub end_answergroup {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $result;
       if ($target eq 'web') {
       if (  &Apache::response::show_answer() ) {  
       my $partid = $Apache::inputtags::part;
       my $id = $Apache::inputtags::response[-1];
       &set_answertext($Apache::lonhomework::history{"resource.$partid.$id.answername"},
       $target,$token,$tagstack,$parstack,$parser,
       $safeeval,-2);
    }
       }
       return $result;
   }
   
   sub start_value {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $result;
       if ( $target eq 'web' || $target eq 'tex' ||
    $target eq 'grade' || $target eq 'webgrade' ||
    $target eq 'answer' || $target eq 'analyze' ) {
    my $bodytext = &Apache::lonxml::get_all_text("/value",$parser,$style);
    $bodytext = &Apache::run::evaluate($bodytext,$safeeval,
      $$parstack[-1]);
   
    push(@{ $answer{$cur_name}{'answers'} },[$bodytext]);
   
       }
       return $result;
   }
   
   sub end_value {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $result;
       return $result;
   }
   
   sub start_vector {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $result;
       if ( $target eq 'web' || $target eq 'tex' ||
    $target eq 'grade' || $target eq 'webgrade' ||
    $target eq 'answer' || $target eq 'analyze' ) {
    my $bodytext = &Apache::lonxml::get_all_text("/vector",$parser,$style);
    my @values = &Apache::run::run($bodytext,$safeeval,$$parstack[-1]);
    if (@values == 1) {
       @values = split(',',$values[0]);
    }
    push(@{ $answer{$cur_name}{'answers'} },\@values);
       }
       return $result;
   }
   
   sub end_vector {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $result;
       return $result;
   }
   
   sub start_array {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $result;
       if ( $target eq 'web' || $target eq 'tex' ||
    $target eq 'grade' || $target eq 'webgrade' ||
    $target eq 'answer' || $target eq 'analyze' ) {
    my $bodytext = &Apache::lonxml::get_all_text("/array",$parser,$style);
    my @values = &Apache::run::evaluate($bodytext,$safeeval,
       $$parstack[-1]);
    push(@{ $answer{$cur_name}{'answers'} },@values);
       }
       return $result;
   }
   
   sub end_array {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $result;
       return $result;
   }
   
   sub start_unit {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $result;
       return $result;
   }
   
   sub end_unit {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $result;
       return $result;
 }  }
   
 sub start_numericalresponse {  sub start_numericalresponse {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       &Apache::lonxml::register('Apache::caparesponse',
         ('answer','answergroup','value','array','unit',
          'vector'));
     my $id = &Apache::response::start_response($parstack,$safeeval);      my $id = &Apache::response::start_response($parstack,$safeeval);
     my $result;      my $result;
       undef(%answer);
       undef(%{$safeeval->varglob('LONCAPA::CAPAresponse_args')});
     if ($target eq 'edit') {      if ($target eq 'edit') {
  $result.=&Apache::edit::tag_start($target,$token);   $result.=&Apache::edit::tag_start($target,$token);
  $result.=&Apache::edit::text_arg('Answer:','answer',$token);   $result.=&Apache::edit::text_arg('Answer:','answer',$token);
  if ($token->[1] eq 'numericalresponse') {   if ($token->[1] eq 'numericalresponse') {
     $result.=&Apache::edit::text_arg('Incorrect Answers:','incorrect',      $result.=&Apache::edit::text_arg('Incorrect Answers:','incorrect',
      $token);       $token).
    &Apache::loncommon::help_open_topic('numerical_wrong_answers');
     $result.=&Apache::edit::text_arg('Unit:','unit',$token,5).      $result.=&Apache::edit::text_arg('Unit:','unit',$token,5).
  &Apache::loncommon::help_open_topic('Physical_Units');   &Apache::loncommon::help_open_topic('Physical_Units');
     $result.=&Apache::edit::text_arg('Format:','format',$token,4).      $result.=&Apache::edit::text_arg('Format:','format',$token,4).
Line 60  sub start_numericalresponse { Line 193  sub start_numericalresponse {
  if ($token->[1] eq 'numericalresponse') {   if ($token->[1] eq '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');
  } 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,
Line 85  sub start_numericalresponse { Line 218  sub start_numericalresponse {
     $safeeval);      $safeeval);
     if ($unit =~ /\S/) { $result.=" (in $unit) "; }      if ($unit =~ /\S/) { $result.=" (in $unit) "; }
  }   }
    if (  &Apache::response::show_answer() ) {
       &set_answertext($tag_internal_answer_name,$target,$token,$tagstack,
       $parstack,$parser,$safeeval,-1);
    }
     }      }
     return $result;      return $result;
 }  }
   
   sub set_answertext {
       my ($name,$target,$token,$tagstack,$parstack,$parser,$safeeval,
    $response_level) = @_;
       &add_in_tag_answer($parstack,$safeeval,$response_level);
   
       return if ($name eq '' || !ref($answer{$name}));
   
       my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,
    $safeeval,$response_level);
       my $unit=&Apache::lonxml::get_param_var('unit',$parstack,$safeeval,
       $response_level);
   
       &Apache::lonxml::debug("answer looks to be $name");
       my @answertxt;
       for (my $i=0; $i < scalar(@{$answer{$name}{'answers'}}); $i++) {
    my $answertxt;
    my $answer=$answer{$name}{'answers'}[$i];
    foreach my $element (@$answer) {
       if ( scalar(@$tagstack)
    && $tagstack->[$response_level] ne 'numericalresponse') {
    $answertxt.=$element.',';
       } else {
    my $format;
    if ($#formats > 0) {
       $format=$formats[$i];
    } else {
       $format=$formats[0];
    }
    if ($unit=~/\$/) { $format="\$".$format; $unit=~s/\$//g; }
    if ($unit=~/\,/) { $format="\,".$format; $unit=~s/\,//g; }
    my $formatted=&format_number($element,$format,$target,
        $safeeval);
    $answertxt.=' '.$formatted.',';
       }
       
    }
    chop($answertxt);
    if ($target eq 'web') {
       $answertxt.=" $unit ";
    }
   
    push(@answertxt,$answertxt)
       }
   
       my $id = $Apache::inputtags::response[-1];
       $Apache::inputtags::answertxt{$id}=\@answertxt;
   }
   
   sub setup_capa_args {
       my ($safeeval,$parstack,$args,$response) = @_;
       my $args_ref= \%{$safeeval->varglob('LONCAPA::CAPAresponse_args')};
       undef(%{ $args_ref });
    
       foreach my $arg (@{$args}) {
    $$args_ref{$arg}=
       &Apache::lonxml::get_param($arg,$parstack,$safeeval);
       }
       foreach my $key (keys(%Apache::inputtags::params)) {
    $$args_ref{$key}=$Apache::inputtags::params{$key};
       }
       &setup_capa_response($args_ref,$response);
       return $args_ref;
   }
   
   sub setup_capa_response {
       my ($args_ref,$response) = @_;   
   
       use Data::Dumper;
       &Apache::lonxml::debug("response dump is ".&Dumper($response));
       
       if (ref($response)) {
    $$args_ref{'response'}=dclone($response);
       } else {
    $$args_ref{'response'}=dclone([$response]);
       }
   }
   
   sub check_submission {
       my ($response,$partid,$id,$tag,$parstack,$safeeval,$ignore_sig)=@_;
       my @args = ('type','tol','sig','format','unit','calc','samples');
       my $args_ref = &setup_capa_args($safeeval,$parstack,\@args,$response);
   
       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") {
    delete($$args_ref{'unit'});
       }
       #sig fig don't make much sense either
       if (($Apache::lonhomework::type eq 'exam' ||
    &Apache::response::submitted('scantron') ||
    $ignore_sig) &&
    $tag eq 'numericalresponse') {
    delete($$args_ref{'sig'});
       }
       
       if ($tag eq 'formularesponse') {
    if ($$args_ref{'samples'}) {
       $$args_ref{'type'}='fml';
    } else {
       $$args_ref{'type'}='math';
    }
       } elsif ($tag eq 'numericalresponse') {
    $$args_ref{'type'}='float';
       }
       
       &add_in_tag_answer($parstack,$safeeval);
   
       my (@final_awards,@final_msgs,@names);
       foreach my $name (keys(%answer)) {
    &Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} }));
   
    ${$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=dclone($answer{$name});
    &setup_capa_response($args_ref,$response);
    use Time::HiRes;
    my $t0 = [Time::HiRes::gettimeofday()];
    my ($result,@msgs) = 
       &Apache::run::run("&caparesponse_check_list()",$safeeval);
    &Apache::lonxml::debug("checking $name $result with $response took ".&Time::HiRes::tv_interval($t0));
    &Apache::lonxml::debug('msgs are '.join(':',@msgs));
    my ($awards)=split(/:/,$result);
    my @awards= split(/,/,$awards);
    my ($ad, $msg) = &Apache::inputtags::finalizeawards(\@awards,\@msgs);
    push(@final_awards,$ad);
    push(@final_msgs,$msg);
    push(@names,$name);
       }
       my ($ad, $msg, $name) = &Apache::inputtags::finalizeawards(\@final_awards,
          \@final_msgs,
          \@names,1);
       &Apache::lonxml::debug(" name of picked award is $name from ".join(', ',@names));
       return($ad,$msg, $name);
   }
   
   sub add_in_tag_answer {
       my ($parstack,$safeeval,$response_level) = @_;
       my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval,
         $response_level);
       &Apache::lonxml::debug('answer is'.join(':',@answer));
       if (@answer && defined($answer[0])) {
    $answer{$tag_internal_answer_name}= {'type' => 'ordered',
        'answers' => [\@answer] };
       }
   }
   
 sub end_numericalresponse {  sub end_numericalresponse {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $increment=1;      my $increment=1;
Line 96  sub end_numericalresponse { Line 379  sub end_numericalresponse {
     if (!$Apache::lonxml::default_homework_loaded) {      if (!$Apache::lonxml::default_homework_loaded) {
  &Apache::lonxml::default_homework_load($safeeval);   &Apache::lonxml::default_homework_load($safeeval);
     }      }
       my $partid = $Apache::inputtags::part;
       my $id = $Apache::inputtags::response[-1];
     my $tag;      my $tag;
       my $safehole = new Safe::Hole;
       $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' && defined($ENV{'form.submitted'})) {      if ( $target eq 'grade' && &Apache::response::submitted() ) {
  &Apache::response::setup_params($tag,$safeeval);   &Apache::response::setup_params($tag,$safeeval);
  $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' &&    if ($Apache::lonhomework::type eq 'exam' && 
     $tag eq 'formularesponse') {      (($tag eq 'formularesponse') || ($tag eq 'mathresponse'))) {
     $increment=&Apache::response::scored_response($partid,$id);      $increment=&Apache::response::scored_response($partid,$id);
  } else {   } else {
     my $response = &Apache::response::getresponse();      my $response = &Apache::response::getresponse();
     if ( $response =~ /[^\s]/) {      if ( $response =~ /[^\s]/) {
  my $ad;  
  my %previous = &Apache::response::check_for_previous($response,$partid,$id);   my %previous = &Apache::response::check_for_previous($response,$partid,$id);
  &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>");
   
  if ($ENV{'form.submitted'} eq 'scantron') {   if ( &Apache::response::submitted('scantron')) {
     my $number_of_bubbles = &Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.numbubbles');      my ($values,$display)=&make_numerical_bubbles($partid,$id,
     if (!$number_of_bubbles) { $number_of_bubbles=8; }    $target,$parstack,$safeeval);
     my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);      $response=$values->[$response];
     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::lonhomework::results{"resource.$partid.$id.submission"}=$response;
  &Apache::lonxml::debug("current $response");   my ($ad,$msg,$name)=&check_submission($response,$partid,$id,
  my $expression="&caparesponse_check_list('".$response."','".        $tag,$parstack,
     $$parstack[-1];        $safeeval);
  my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffunit');  
   
  foreach my $key (keys(%Apache::inputtags::params)) {  
     $expression.= ';my $__LC__'. #'  
  $key.'="'.$Apache::inputtags::params{$key}.'"';  
  }  
   
  #no way to enter units, with radio buttons  
  if ($Apache::lonhomework::type eq 'exam' ||  
     lc($hideunit) eq "yes") {  
     $expression.=';my $__LC__unit=undef;';  
  }  
  #sig fig don't make much sense either  
  if (($Apache::lonhomework::type eq 'exam' ||  
      $ENV{'form.submitted'} eq 'scantron') &&  
     $tag eq 'numericalresponse') {  
     $expression.=';my $__LC__sig=undef;';  
  }  
   
  if ($tag eq 'formularesponse') {   &Apache::lonxml::debug('ad is'.$ad);
     $expression.=';my $__LC__type="fml";';   if ($ad eq 'SIG_FAIL') {
  } elsif ($tag eq 'numericalresponse') {      my ($sig_u,$sig_l)=
     $expression.=';my $__LC__type="float";';   &get_sigrange($Apache::inputtags::params{'sig'});
  }      $msg=join(':',$msg,$sig_l,$sig_u);
  $expression.="');";      &Apache::lonxml::debug("sigs bad $sig_u $sig_l ".
  my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval);     $Apache::inputtags::params{'sig'});
  &Apache::lonxml::debug('answer is'.join(':',@answer));   }
  @{$safeeval->varglob('CAPARESPONSE_CHECK_LIST_answer')}=@answer;  
   
  ($result,my @msgs) = &Apache::run::run($expression,$safeeval);  
  &Apache::lonxml::debug('msgs are'.join(':',@msgs));  
  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::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n");
    if ($Apache::lonhomework::type eq 'survey' &&
       ($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' ||
        $ad eq 'EXACT_ANS')) {
       $ad='SUBMITTED';
    }
  &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.answername"}=$name;
  $result='';   $result='';
     }      }
  }   }
     } elsif ($target eq 'web' || $target eq 'tex') {      } elsif ($target eq 'web' || $target eq 'tex') {
  my (@answers)=&Apache::lonxml::get_param_var('answer',$parstack,   &check_for_answer_errors($parstack,$safeeval);
      $safeeval);  
  my $award = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};   my $award = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
  my $status = $Apache::inputtags::status['-1'];   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 />".&mt('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') {   if ($Apache::lonhomework::type eq 'exam') {
     my $partid=$Apache::inputtags::part;      # FIXME support multi dimensional numerical problems
     my $id=$Apache::inputtags::response[-1];              #       in exam bubbles
     my $number_of_bubbles = &Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.numbubbles');      my ($bubble_values,$bubble_display)=
     if ($Apache::inputtags::params{'numbubbles'}) {   &make_numerical_bubbles($partid,$id,$target,$parstack,
  $number_of_bubbles = $Apache::inputtags::params{'numbubbles'};   $safeeval);
     }      my $number_of_bubbles = scalar(@{ $bubble_values });
     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,      my $unit=&Apache::lonxml::get_param_var('unit',$parstack,
     $safeeval);      $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 @alphabet=('A'..'Z');
     if ($target eq 'web') {      if ($target eq 'web') {
  if ($tag eq 'numericalresponse') {   if ($tag eq 'numericalresponse') {
Line 236  sub end_numericalresponse { Line 451  sub end_numericalresponse {
     my $previous=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.$id.submission"};      my $previous=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.$id.submission"};
     for (my $ind=0;$ind<$number_of_bubbles;$ind++) {      for (my $ind=0;$ind<$number_of_bubbles;$ind++) {
  my $checked='';   my $checked='';
  if ($previous eq $bubble_values[$ind]) {   if ($previous eq $bubble_values->[$ind]) {
     $checked=" checked='on' ";      $checked=" checked='on' ";
  }   }
  $result.='<td><input type="radio" name="HWVAL_'.$id.   $result.='<td><input type="radio" name="HWVAL_'.$id.
     '" value="'.$bubble_values[$ind].'" '.$checked      '" value="'.$bubble_values->[$ind].'" '.$checked
     .' /><b>'.$alphabet[$ind].'</b>: '.      .' /><b>'.$alphabet[$ind].'</b>: '.
     $bubble_values[$ind].'</td>';      $bubble_display->[$ind].'</td>';
     }      }
     $result.='</tr></table>';      $result.='</tr></table>';
  } elsif ($tag eq 'formularesponse') {  
     $result.= '<br /><br /><font color="red">  
                            <textarea name="HWVAL_'.$id.'" rows="4" cols="50">  
                            </textarea></font> <br /><br />';  
  }   }
     } elsif ($target eq 'tex') {      } elsif ($target eq 'tex') {
  if ((defined $unit) and ($unit=~/\S/) and ($Apache::lonhomework::type eq 'exam')) {   if ((defined $unit) and ($unit=~/\S/) and ($Apache::lonhomework::type eq 'exam')) {
Line 256  sub end_numericalresponse { Line 467  sub end_numericalresponse {
  }   }
  if ($tag eq 'numericalresponse') {   if ($tag eq 'numericalresponse') {
     my ($celllength,$number_of_tables,@table_range)=      my ($celllength,$number_of_tables,@table_range)=
  &get_table_sizes($number_of_bubbles,\@bubble_values);   &get_table_sizes($number_of_bubbles,$bubble_display);
     my $j=0;      my $j=0;
     my $cou=0;      my $cou=0;
     $result.='\vskip -1 mm \noindent \begin{enumerate}\item[\textbf{'.$Apache::lonxml::counter.'}.]';      $result.='\vskip -1 mm \noindent \begin{enumerate}\item[\textbf{'.$Apache::lonxml::counter.'}.]';
     for (my $i=0;$i<$number_of_tables;$i++) {      for (my $i=0;$i<$number_of_tables;$i++) {
  $result.='\vskip -1 mm \noindent \begin{tabular}{';   $result.='\vskip -1 mm \noindent \setlength{\tabcolsep}{2 mm}\begin{tabular}{';
  for (my $ind=0;$ind<$table_range[$j];$ind++) {   for (my $ind=0;$ind<$table_range[$j];$ind++) {
     $result.='p{3 mm}p{'.$celllength.' mm}';      $result.='p{3 mm}p{'.$celllength.' mm}';
  }   }
  $result.='}';   $result.='}';
  for (my $ind=$cou;$ind<$cou+$table_range[$j];$ind++) {   for (my $ind=$cou;$ind<$cou+$table_range[$j];$ind++) {
     $result.='\hskip -4 mm {\small \textbf{'.$alphabet[$ind].'}}$\bigcirc$ & \hskip -3 mm {\small '.$bubble_values[$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.=' & ';}      if ($ind != $cou+$table_range[$j]-1) {$result.=' & ';}
  }   }
  $cou += $table_range[$j];   $cou += $table_range[$j];
Line 276  sub end_numericalresponse { Line 487  sub end_numericalresponse {
     }      }
     $result.='\end{enumerate}';      $result.='\end{enumerate}';
  } else {   } else {
     $result.='\fbox{\fbox{\parbox{\textwidth-5mm}{\strut\\\\\strut\\\\\strut\\\\\strut\\\\}}}';      $increment = &Apache::response::repetition();
     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') {      } 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') {
    my $part_id="$partid.$id";
  my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]";  
  if ($target eq 'analyze') {   if ($target eq 'analyze') {
     push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id);      push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id);
     $Apache::lonhomework::analyze{"$part_id.type"} = $tag;      $Apache::lonhomework::analyze{"$part_id.type"} = $tag;
     my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack,$safeeval);      my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack,$safeeval);
       if ($#incorrect eq 0) { @incorrect=(split(/,/,$incorrect[0])); }
     push (@{ $Apache::lonhomework::analyze{"$part_id.incorrect"} }, @incorrect);      push (@{ $Apache::lonhomework::analyze{"$part_id.incorrect"} }, @incorrect);
       &Apache::response::check_if_computed($token,$parstack,
    $safeeval,'answer');
  }   }
  if (scalar(@$tagstack)) {   if (scalar(@$tagstack)) {
     &Apache::response::setup_params($tag,$safeeval);      &Apache::response::setup_params($tag,$safeeval);
  }   }
  my (@answers)=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval);   &add_in_tag_answer($parstack,$safeeval);
  my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);   my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);
   
  my $unit=&Apache::lonxml::get_param_var('unit',$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') {   if ($target eq 'answer') {
     $result.=&Apache::response::answer_header($tag);      $result.=&Apache::response::answer_header($tag,undef,
         scalar(keys(%answer)));
       if ($tag eq 'numericalresponse'
    && $Apache::lonhomework::type eq 'exam') {
    my ($bubble_values,undef,$correct) = &make_numerical_bubbles($partid,
        $id,$target,$parstack,$safeeval);
    $result.=&Apache::response::answer_part($tag,$correct);
       }
  }   }
  for(my $i=0;$i<=$#answers;$i++) {   foreach my $name (sort(keys(%answer))) {
     my $ans=$answers[$i];      my @answers = @{ $answer{$name}{'answers'} };
     my $fmt=$formats[0];      if ($target eq 'analyze') {
     if (@formats && $#formats) {$fmt=$formats[$i];}   foreach my $info ('answer','ans_high','ans_low','format') {
     my ($high,$low);      $Apache::lonhomework::analyze{"$part_id.$info"}{$name}=[];
     if ($Apache::inputtags::params{'tol'}) {   }
  ($high,$low)=&get_tolrange($ans,$Apache::inputtags::params{'tol'});      }
     }      my ($sigline,$tolline);
     my ($sighigh,$siglow);      if ($name ne $tag_internal_answer_name 
     if ($Apache::inputtags::params{'sig'}) {   || scalar(keys(%answer)) > 1) {
  ($sighigh,$siglow)=&get_sigrange($Apache::inputtags::params{'sig'});   $result.=&Apache::response::answer_part($tag,$name);
     }      }
     if ($fmt && $tag eq 'numericalresponse') {      for(my $i=0;$i<=$#answers;$i++) {
  $fmt=~s/e/E/g;   my $ans=$answers[$i];
  $ans = sprintf('%.'.$fmt,$ans);   my $fmt=$formats[0];
  if ($high) {   if (@formats && $#formats) {$fmt=$formats[$i];}
     $high=sprintf('%.'.$fmt,$high);   my ($sighigh,$siglow);
     $low =sprintf('%.'.$fmt,$low);   if ($Apache::inputtags::params{'sig'}) {
  }      ($sighigh,$siglow)=&get_sigrange($Apache::inputtags::params{'sig'});
     }   }
     if ($target eq 'answer') {   my @vector;
  if ($high && $tag eq 'numericalresponse') { $ans.=' ['.$low.','.$high.']'; }   if (ref($ans)) {
  if ($sighigh && $tag eq 'numericalresponse') {      @vector = @{ $ans };
     if ($ENV{'form.answer_output_mode'} eq 'tex') {   } else {
  $ans.= " Sig $siglow - $sighigh";      @vector = ($ans);
     } else {   }
  $ans.= " Sig <i>$siglow - $sighigh</i>";   my @all_answer_info;
    foreach my $element (@vector) {
       my ($high,$low);
       if ($Apache::inputtags::params{'tol'}) {
    ($high,$low)=&get_tolrange($element,$Apache::inputtags::params{'tol'});
       }
       if ($target eq 'answer') {
    if ($fmt && $tag eq 'numericalresponse') {
       $fmt=~s/e/E/g;
       if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; }
       if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; }
       $element = &format_number($element,$fmt,$target,$safeeval);
       #if ($high) {
       #    $high=&format_number($high,$fmt,$target,$safeeval);
       #    $low =&format_number($low,$fmt,$target,$safeeval);
       #}
    }
    if ($high && $tag eq 'numericalresponse') {
       $element.=' ['.$low.','.$high.']';
       $tolline .= "[$low, $high]";
    }
    if (defined($sighigh) && $tag eq 'numericalresponse') {
       if ($env{'form.answer_output_mode'} eq 'tex') {
    $element.= " Sig $siglow - $sighigh";
       } else {
    $element.= " Sig <i>$siglow - $sighigh</i>";
    $sigline .= "[$siglow, $sighigh]";
       }
    }
    push(@all_answer_info,$element);
   
       } elsif ($target eq 'analyze') {
    push (@{ $Apache::lonhomework::analyze{"$part_id.answer"}{$name}[$i] }, $element);
    if ($high) {
       push (@{ $Apache::lonhomework::analyze{"$part_id.ans_high"}{$name}[$i] }, $high);
       push (@{ $Apache::lonhomework::analyze{"$part_id.ans_low"}{$name}[$i] }, $low);
    }
    if ($fmt) {
       push (@{ $Apache::lonhomework::analyze{"$part_id.format"}{$name}[$i] }, $fmt);
    }
     }      }
  }   }
  $result.=&Apache::response::answer_part($tag,$ans);   if ($target eq 'answer') {
     } elsif ($target eq 'analyze') {      $result.= &Apache::response::answer_part($tag,join(', ',@all_answer_info));
  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      my @fmt_ans;
     $tag eq 'numericalresponse') {      for(my $i=0;$i<=$#answers;$i++) {
     if ($target eq 'answer') {   my $ans=$answers[$i];
  if ($ENV{'form.answer_output_mode'} eq 'tex') {   my $fmt=$formats[0];
     $result.=&Apache::response::answer_part($tag,   if (@formats && $#formats) {$fmt=$formats[$i];}
     " Unit: $unit ");   foreach my $element (@$ans) {    
       if ($fmt && $tag eq 'numericalresponse') {
    $fmt=~s/e/E/g;
    if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; }
    if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; }
    $element = &format_number($element,$fmt,$target,
     $safeeval);
    if ($fmt=~/\$/ && $unit!~/\$/) { $element=~s/\$//; }
       }
    }
    push(@fmt_ans,join(',',@$ans));
       }
       my $response=\@fmt_ans;
   
       my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.
         $id.'.turnoffunit');
       if ($unit ne ''  && 
    ! ($Apache::lonhomework::type eq 'exam' ||
      lc($hideunit) eq "yes") )  {
    my $cleanunit=$unit;
    $cleanunit=~s/\$\,//g;
    foreach my $ans (@fmt_ans) {
       $ans.=" $cleanunit";
    }
       }
       my ($ad,$msg)=&check_submission($response,$partid,$id,$tag,
       $parstack,$safeeval);
       if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
    my $error;
    if ($tag eq 'formularesponse') {
       $error=&mt('Computer\'s answer is incorrect ("[_1]").',join(', ',@$response));
    } else {
       # answer failed check if it is sig figs that is failing
       my ($ad,$msg)=&check_submission($response,$partid,$id,
       $tag,$parstack,
       $safeeval,1);
       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);
       } else {
    $error=&mt('Computer\'s answer is incorrect ("[_1]"). It is likely that the tolerance range [_2] needs to be adjusted.',join(', ',@$response),$tolline);
       }
    }
    if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
       &Apache::lonxml::error($error);
  } else {   } else {
     $result.=&Apache::response::answer_part($tag,      &Apache::lonxml::warning($error);
     "Unit: <b>$unit</b>");  
  }   }
     } elsif ($target eq 'analyze') {  
  push (@{ $Apache::lonhomework::analyze{"$part_id.unit"} }, $unit);  
     }      }
  }  
  if ($tag eq 'formularesponse' && $target eq 'answer') {      if (defined($unit) and ($unit ne '') and
     my $samples=&Apache::lonxml::get_param('samples',$parstack,$safeeval);   $tag eq 'numericalresponse') {
     $result.=&Apache::response::answer_part($tag,$samples);   if ($target eq 'answer') {
       if ($env{'form.answer_output_mode'} eq 'tex') {
    $result.=&Apache::response::answer_part($tag,
    " Unit: $unit ");
       } else {
    $result.=&Apache::response::answer_part($tag,
    "Unit: <b>$unit</b>");
       }
    } elsif ($target eq 'analyze') {
       push (@{ $Apache::lonhomework::analyze{"$part_id.unit"} }, $unit);
    }
       }
       if ($tag eq 'formularesponse' && $target eq 'answer') {
    my $samples=&Apache::lonxml::get_param('samples',$parstack,$safeeval);
    $result.=&Apache::response::answer_part($tag,$samples);
       }
       $result.=&Apache::response::next_answer($tag,$name);
  }   }
  if ($target eq 'answer') {   if ($target eq 'answer') {
     $result.=&Apache::response::answer_footer($tag);      $result.=&Apache::response::answer_footer($tag);
Line 373  sub end_numericalresponse { Line 677  sub end_numericalresponse {
  $target eq 'tex' || $target eq 'analyze') {   $target eq 'tex' || $target eq 'analyze') {
  &Apache::lonxml::increment_counter($increment);   &Apache::lonxml::increment_counter($increment);
     }      }
     &Apache::response::end_response;      &Apache::response::end_response();
     return $result;      return $result;
 }  }
   
   sub check_for_answer_errors {
       my ($parstack,$safeeval) = @_;
       &add_in_tag_answer($parstack,$safeeval);
       my %counts;
       foreach my $name (keys(%answer)) {
    push(@{$counts{scalar(@{$answer{$name}{'answers'}})}},$name);
       }
       if (scalar(keys(%counts)) > 1) {
    my $counts = join(' ',map {
       my $count = $_;
       &mt("Answers [_1] had [_2] components.",
    '<tt>'.join(', ',@{$counts{$count}}).'</tt>',
    $count);
    } (sort(keys(%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];
       if ( $expected_number_of_inputs != scalar(@Apache::inputtags::inputlist)) {
    &Apache::lonxml::error(&mt("Expected [_1] input fields, but there were only [_2] seen.", 
      $expected_number_of_inputs,
      scalar(@Apache::inputtags::inputlist)));
       }
   }
   
 sub get_table_sizes {  sub get_table_sizes {
     my ($number_of_bubbles,$rbubble_values)=@_;      my ($number_of_bubbles,$rbubble_values)=@_;
     my $scale=2; #mm for one digit      my $scale=2; #mm for one digit
     my $cell_width=0;      my $cell_width=0;
     foreach my $member (@$rbubble_values) {      foreach my $member (@$rbubble_values) {
  my $cell_width_real=0;   my $cell_width_real=0;
  if ($member=~/(\+|-)?(\d*)\.?(\d*)\s*\$\\times\s*10\^{(\+|-)?(\d+)}\$/) {   if ($member=~/(\+|-)?(\d*)\.?(\d*)\s*\$?\\times\s*10\^{(\+|-)?(\d+)}\$?/) {
     $cell_width_real=(length($2)+length($3)+length($5)+7)*$scale;      $cell_width_real=(length($2)+length($3)+length($5)+7)*$scale;
  } elsif ($member=~/(\d*)\.?(\d*)(E|e)(\+|-)?(\d*)/) {   } elsif ($member=~/(\d*)\.?(\d*)(E|e)(\+|-)?(\d*)/) {
     $cell_width_real=(length($1)+length($2)+length($5)+9)*$scale;      $cell_width_real=(length($1)+length($2)+length($5)+9)*$scale;
Line 396  sub get_table_sizes { Line 726  sub get_table_sizes {
     }      }
     $cell_width+=8;       $cell_width+=8; 
     my $textwidth;      my $textwidth;
     if ($ENV{'form.textwidth'} ne '') {      if ($env{'form.textwidth'} ne '') {
  $ENV{'form.textwidth'}=~/(\d*)\.?(\d*)/;   $env{'form.textwidth'}=~/(\d*)\.?(\d*)/;
  $textwidth=$1.'.'.$2;   $textwidth=$1.'.'.$2;
     } else {      } else {
  $ENV{'textwidth'}=~/(\d+)\.?(\d*)/;   $env{'form.textwidth'}=~/(\d+)\.?(\d*)/;
  $textwidth=$1.'.'.$2;   $textwidth=$1.'.'.$2;
     }      }
     my $bubbles_per_line=int($textwidth/$cell_width);      my $bubbles_per_line=int($textwidth/$cell_width);
     if (($bubbles_per_line > $number_of_bubbles/2) && ($number_of_bubbles % 2==0)) {$bubbles_per_line=$number_of_bubbles/2;}      if ($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;}
     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 418  sub get_table_sizes { Line 750  sub get_table_sizes {
 }  }
   
 sub format_number {  sub format_number {
     my ($number,$format,$target)=@_;      my ($number,$format,$target,$safeeval)=@_;
     my $ans;      my $ans;
     if ($format ne '') {      if ($format eq '') {
  $format=~s/e/E/g;  
  $ans = sprintf('%.'.$format,$number);  
     } else {  
  my $format = '';  
  #What is the number? (integer,decimal,floating point)   #What is the number? (integer,decimal,floating point)
  if ($number=~/^(\d*\.?\d*)(E|e)(\d*)$/) {   if ($number=~/^(\d*\.?\d*)(E|e)[+\-]?(\d*)$/) {
     $format = '3e';      $format = '3e';
  } elsif ($number=~/^(\d*)\.(\d*)$/) {   } elsif ($number=~/^(\d*)\.(\d*)$/) {
     $format = '4f';      $format = '4f';
  } elsif ($number=~/^(\d*)$/) {   } elsif ($number=~/^(\d*)$/) {
     $format = 'd';      $format = 'd';
  }   }
  $ans = sprintf('%.'.$format,$number);  
     }      }
     if ($target eq 'tex') {      if (!$Apache::lonxml::default_homework_loaded) {
  if ($ans =~ m/([0-9\.\-\+]+)E([0-9\-\+]+)/ ) {   &Apache::lonxml::default_homework_load($safeeval);
     my $number = $1;  
     my $power = $2;  
     $power=~s/^\+//;  
     $power=~s/^(-?)0+(\d+)/$1$2/;  
     $ans=$number.'$\times 10^{'.$power.'}$'; #'stupidemacs  
  }  
     }      }
       $ans=&Apache::run::run("&prettyprint(q\0$number\0,q\0$format\0,q\0$target\0)",$safeeval);
     return $ans;      return $ans;
 }  }
   
 sub make_numerical_bubbles {  sub make_numerical_bubbles {
     my ($number_of_bubbles,$target,$answer,$format,$incorrect) =@_;      my ($part,$id,$target,$parstack,$safeeval) =@_;
     my @bubble_values = ();      
     &Apache::lonxml::debug("answer is $answer incorrect is $incorrect");      my $number_of_bubbles = 
    &Apache::response::get_response_param($part.'_'.$id,'numbubbles',8);
   
       my ($format)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);
       my $name = (exists($answer{$tag_internal_answer_name}) 
    ? $tag_internal_answer_name
    : (sort(keys(%answer)))[0]);
   
       if ( scalar(@{$answer{$name}{'answers'}}) > 1) {
    &Apache::lonxml::error("Only answers with 1 component are supported in exam mode");
       }
       if (scalar(@{$answer{$name}{'answers'}[0]}) > 1) {
    &Apache::lonxml::error("Vector answers are unsupported in exam mode.");
       }
   
       my $answer = $answer{$name}{'answers'}[0][0];
       my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack,
      $safeeval);
       if ($#incorrect eq 0) { @incorrect=(split(/,/,$incorrect[0])); }
       
       my @bubble_values=();
       my @alphabet=('A'..'Z');
   
       &Apache::lonxml::debug("answer is $answer incorrect is @incorrect");
     my @oldseed=&Math::Random::random_get_seed();      my @oldseed=&Math::Random::random_get_seed();
     if (defined($incorrect) && ref($incorrect)) {      if (@incorrect) {
  &Apache::lonxml::debug("inside ".(scalar(@$incorrect)+1 gt $number_of_bubbles));   &Apache::lonxml::debug("inside ".(scalar(@incorrect)+1 gt $number_of_bubbles));
  if (defined($$incorrect[0]) &&   if (defined($incorrect[0]) &&
     scalar(@$incorrect)+1 >= $number_of_bubbles) {      scalar(@incorrect)+1 >= $number_of_bubbles) {
     &Apache::lonxml::debug("inside ".(scalar(@$incorrect)+1).":$number_of_bubbles");      &Apache::lonxml::debug("inside ".(scalar(@incorrect)+1).":$number_of_bubbles");
     &Apache::response::setrandomnumber();      &Apache::response::setrandomnumber();
     my @rand_inc=&Math::Random::random_permutation(@$incorrect);      my @rand_inc=&Math::Random::random_permutation(@incorrect);
     @bubble_values=@rand_inc[0..($number_of_bubbles-2)];      @bubble_values=@rand_inc[0..($number_of_bubbles-2)];
     @bubble_values=sort {$a <=> $b} (@bubble_values,$answer);      @bubble_values=sort {$a <=> $b} (@bubble_values,$answer);
     &Apache::lonxml::debug("Answer was :$answer: returning :".$#bubble_values.": whih are :".join(':',@bubble_values));      &Apache::lonxml::debug("Answer was :$answer: returning :".$#bubble_values.": which are :".join(':',@bubble_values));
     &Math::Random::random_set_seed(@oldseed);      &Math::Random::random_set_seed(@oldseed);
   
       my $correct;
       for(my $i=0; $i<=$#bubble_values;$i++) {
    if ($bubble_values[$i] eq $answer) {
       $correct = $alphabet[$i];
       last;
    }
       }
   
     if (defined($format) && $format ne '') {      if (defined($format) && $format ne '') {
    my @bubble_display;
  foreach my $value (@bubble_values) {   foreach my $value (@bubble_values) {
     $value=&format_number($value,$format,$target);      push(@bubble_display,
    &format_number($value,$format,$target,$safeeval));
  }   }
    return (\@bubble_values,\@bubble_display,$correct);
       } else {
    return (\@bubble_values,\@bubble_values,$correct);
     }      }
     return @bubble_values;  
  }   }
  if (defined($$incorrect[0]) &&   if (defined($incorrect[0]) &&
     scalar(@$incorrect)+1 < $number_of_bubbles) {      scalar(@incorrect)+1 < $number_of_bubbles) {
     &Apache::lonxml::warning("Not enough incorrect answers were specified in the incorrect array, ignoring the specified incorrect answers and instead generating them.");      &Apache::lonxml::warning("Not enough incorrect answers were specified in the incorrect array, ignoring the specified incorrect answers and instead generating them (".join(',',@incorrect).").");
  }   }
     }      }
     my @factors = (1.13,1.17,1.25,1.33,1.45); #default values of factors      my @factors = (1.13,1.17,1.25,1.33,1.45); #default values of factors
Line 482  sub make_numerical_bubbles { Line 840  sub make_numerical_bubbles {
     my $power = $powers[$ind];      my $power = $powers[$ind];
     $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;
     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] = $answer*($factor**($power-$powers[$#powers-$ind]));
  $bubble_values[$ind] = &format_number($bubble_values[$ind],   $bubble_display[$ind] = &format_number($bubble_values[$ind],
        $format,$target);         $format,$target,$safeeval);
   
     }      }
       my $correct = $alphabet[$number_of_bubbles-$power];
     &Math::Random::random_set_seed(@oldseed);      &Math::Random::random_set_seed(@oldseed);
     return @bubble_values;      return (\@bubble_values,\@bubble_display,$correct);
 }  }
   
 sub get_tolrange {  sub get_tolrange {
Line 509  sub get_tolrange { Line 869  sub get_tolrange {
   
 sub get_sigrange {  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'};
       if (lc($env{"course.$courseid.disablesigfigs"}) eq 'yes') {
    return (15,0);
       }
     my $sig_lbound;      my $sig_lbound;
     my $sig_ubound;      my $sig_ubound;
     if ($sig eq '') {      if ($sig eq '') {
Line 517  sub get_sigrange { Line 881  sub get_sigrange {
  $sig_ubound =15; #SIG_UB_DEFAULT   $sig_ubound =15; #SIG_UB_DEFAULT
     } else {      } else {
  ($sig_lbound,$sig_ubound) = split(/,/,$sig);   ($sig_lbound,$sig_ubound) = split(/,/,$sig);
  if (!$sig_lbound) {   if (!defined($sig_lbound)) {
     $sig_lbound = 0; #SIG_LB_DEFAULT      $sig_lbound = 0; #SIG_LB_DEFAULT
     $sig_ubound =15; #SIG_UB_DEFAULT      $sig_ubound =15; #SIG_UB_DEFAULT
  }   }
  if (!$sig_ubound) { $sig_ubound=$sig_lbound; }   if (!defined($sig_ubound)) { $sig_ubound=$sig_lbound; }
     }      }
     if (($sig_ubound<$sig_lbound) ||      if (($sig_ubound<$sig_lbound) ||
  ($sig_lbound > 15) ||   ($sig_lbound > 15) ||
  ($sig =~/(\+|-)/ ) ) {   ($sig =~/(\+|-)/ ) ) {
  my $errormsg=&mt("Invalid Significant figures detected")." ($sig)";   my $errormsg=&mt("Invalid Significant figures detected")." ($sig)";
  if ($ENV{'request.state'} eq 'construct') {   if ($env{'request.state'} eq 'construct') {
     $errormsg.=      $errormsg.=
  &Apache::loncommon::help_open_topic('Significant_Figures');   &Apache::loncommon::help_open_topic('Significant_Figures');
  }   }
Line 541  sub start_stringresponse { Line 905  sub start_stringresponse {
     my $result;      my $result;
     my $id = &Apache::response::start_response($parstack,$safeeval);      my $id = &Apache::response::start_response($parstack,$safeeval);
     if ($target eq 'meta') {      if ($target eq 'meta') {
  &Apache::response::start_response($parstack,$safeeval);  
  $result=&Apache::response::meta_package_write('stringresponse');   $result=&Apache::response::meta_package_write('stringresponse');
  &Apache::response::end_response();  
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result.=&Apache::edit::tag_start($target,$token);   $result.=&Apache::edit::tag_start($target,$token);
  $result.=&Apache::edit::text_arg('Answer:','answer',$token);   $result.=&Apache::edit::text_arg('Answer:','answer',$token);
Line 551  sub start_stringresponse { Line 913  sub start_stringresponse {
  [['cs','Case Sensitive'],['ci','Case Insensitive'],   [['cs','Case Sensitive'],['ci','Case Insensitive'],
   ['mc','Case Insensitive, Any Order'],    ['mc','Case Insensitive, Any Order'],
   ['re','Regular Expression']],$token);    ['re','Regular Expression']],$token);
  $result.=&Apache::edit::checked_arg('Answer Display:','answerdisplay',   $result.=&Apache::edit::text_arg('String to display for answer:',
     [['inline','Inline']],$token);   'answerdisplay',$token);
  $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');
        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();
        }   }
       } elsif ($target eq 'web') {
    if (  &Apache::response::show_answer() ) {
       my $answer=
          &Apache::lonxml::get_param('answerdisplay',$parstack,$safeeval);
       if (!defined $answer || $answer eq '') {
    $answer=
       &Apache::lonxml::get_param('answer',$parstack,$safeeval);
       }
       $Apache::inputtags::answertxt{$id}=[$answer];
    } 
     } elsif ($target eq 'answer' || $target eq 'grade') {      } elsif ($target eq 'answer' || $target eq 'grade') {
  &Apache::response::reset_params();   &Apache::response::reset_params();
     }      }
Line 571  sub start_stringresponse { Line 943  sub start_stringresponse {
   
 sub end_stringresponse {  sub end_stringresponse {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $increment=1;  
     my $result = '';      my $result = '';
     my $part=$Apache::inputtags::part;      my $part=$Apache::inputtags::part;
     my $id=$Apache::inputtags::response[-1];      my $id=$Apache::inputtags::response[-1];
Line 582  sub end_stringresponse { Line 954  sub end_stringresponse {
     if (!$Apache::lonxml::default_homework_loaded) {      if (!$Apache::lonxml::default_homework_loaded) {
  &Apache::lonxml::default_homework_load($safeeval);   &Apache::lonxml::default_homework_load($safeeval);
     }      }
     if ( $target eq 'grade' && defined($ENV{'form.submitted'})) {      if ( $target eq 'grade' && &Apache::response::submitted() ) {
  &Apache::response::setup_params('stringresponse',$safeeval);   &Apache::response::setup_params('stringresponse',$safeeval);
  $safeeval->share_from('capa',['&caparesponse_capa_check_answer']);   $safeeval->share_from('capa',['&caparesponse_capa_check_answer']);
  if ($Apache::lonhomework::type eq 'exam' ||   if ($Apache::lonhomework::type eq 'exam' ||
     $ENV{'form.submitted'} eq 'scantron') {      &Apache::response::submitted('scantron')) {
     $increment=&Apache::response::scored_response($part,$id);      &Apache::response::scored_response($part,$id);
   
  } else {   } else {
     my $response = &Apache::response::getresponse();      my $response = &Apache::response::getresponse();
     if ( $response =~ /[^\s]/) {      if ( $response =~ /[^\s]/) {
Line 595  sub end_stringresponse { Line 968  sub end_stringresponse {
     $part,$id);      $part,$id);
  &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"}=
     $response;      $response;
  my $ad;   my ($ad,$msg);
  if ($type eq 're' ) {    if ($type eq 're' ) { 
     # if the RE wasn't in a var it likely got munged,      # if the RE wasn't in a var it likely got munged,
                     # thus grab it from the var directly                      # thus grab it from the var directly
Line 606  sub end_stringresponse { Line 978  sub end_stringresponse {
 #    if ($testans !~ m/^\s*\$/) {  #    if ($testans !~ m/^\s*\$/) {
 # $answer=$token->[2]->{'answer'};  # $answer=$token->[2]->{'answer'};
 #    }  #    }
     ${$safeeval->varglob('LONCAPA_INTERNAL_response')}=      ${$safeeval->varglob('LONCAPA::response')}=$response;
  $response;      $result = &Apache::run::run('if ($LONCAPA::response=~m'.$answer.') { return 1; } else { return 0; }',$safeeval);
     $result = &Apache::run::run('return $LONCAPA_INTERNAL_response=~m'.$answer,$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 {
     $response =~ s/\\/\\\\/g;      my @args = ('type');
     $response =~ s/\'/\\\'/g;      my $args_ref = &setup_capa_args($safeeval,$parstack,
     &Apache::lonxml::debug("current $response");      \@args,$response);
     my $expression="&caparesponse_check_list('".$response."','".  
  $$parstack[-1];      &add_in_tag_answer($parstack,$safeeval);
     foreach my $key (keys(%Apache::inputtags::params)) {      my (@final_awards,@final_msgs,@names);
  $expression.= ';my $'. #'      foreach my $name (keys(%answer)) {
     $key.'="'.$Apache::inputtags::params{$key}.'"';   &Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} }));
    ${$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=dclone($answer{$name});
    my ($result, @msgs)=&Apache::run::run("&caparesponse_check_list()",$safeeval);
    &Apache::lonxml::debug('msgs are'.join(':',@msgs));
    my ($awards)=split(/:/,$result);
    my (@awards) = split(/,/,$awards);
    ($ad,$msg) = 
       &Apache::inputtags::finalizeawards(\@awards,\@msgs);
    push(@final_awards,$ad);
    push(@final_msgs,$msg);
    push(@names,$name);
    &Apache::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n");
     }      }
     $expression.="');";      my ($ad, $msg, $name) = 
     &Apache::lonxml::debug('answer is'.join(':',$answer));   &Apache::inputtags::finalizeawards(\@final_awards,
     @{$safeeval->varglob('CAPARESPONSE_CHECK_LIST_answer')}=($answer);     \@final_msgs,
     $result = &Apache::run::run($expression,$safeeval);     \@names,1);
     my ($awards) = split /:/ , $result;   }
     ($ad) = &Apache::inputtags::finalizeawards(split /,/ , $awards);   if ($Apache::lonhomework::type eq 'survey' &&
     &Apache::lonxml::debug("$expression");      ($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' ||
     &Apache::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n");       $ad eq 'EXACT_ANS')) {
       $ad='SUBMITTED';
  }   }
  &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;
     }      }
  }   }
     } elsif ($target eq 'web' || $target eq 'tex') {  
  my $award = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};  
  my $status = $Apache::inputtags::status['-1'];  
  if (  &Apache::response::show_answer() ) {  
     if ($target eq 'web') {  
  $result=($answerdisplay eq 'inline'?'':"<br />".&mt('The correct answer is')." ")  
     .$answer;  
 #    join(', ',@answers).".<br />";  
     }  
  }  
  if ($Apache::lonhomework::type eq 'exam' && $target eq 'tex') {  
     $result.='\fbox{\fbox{\parbox{\textwidth-5mm}{\strut\\\\\strut\\\\\strut\\\\\strut\\\\}}}';  
     $increment = &Apache::response::repetition();  
     $result.='\begin{enumerate}';  
     for (my $i=0;$i<$increment;$i++) {  
  $result.='\item[\textbf{'.($Apache::lonxml::counter+$i).  
     '}.]\textit{Leave blank on scoring form}\vskip 0 mm';  
     }  
     $result.= '\end{enumerate}';  
  }  
     } elsif ($target eq 'answer' || $target eq 'analyze') {      } elsif ($target eq 'answer' || $target eq 'analyze') {
    &add_in_tag_answer($parstack,$safeeval);
  if ($target eq 'analyze') {   if ($target eq 'analyze') {
     push (@{ $Apache::lonhomework::analyze{"parts"} },"$part.$id");      push (@{ $Apache::lonhomework::analyze{"parts"} },"$part.$id");
     $Apache::lonhomework::analyze{"$part.$id.type"} = 'stringresponse';      $Apache::lonhomework::analyze{"$part.$id.type"} = 'stringresponse';
       &Apache::response::check_if_computed($token,$parstack,$safeeval,
    'answer');
  }   }
  &Apache::response::setup_params('stringresponse',$safeeval);   &Apache::response::setup_params('stringresponse',$safeeval);
  if ($target eq 'answer') {   if ($target eq 'answer') {
     $result.=&Apache::response::answer_header('stringresponse');      $result.=&Apache::response::answer_header('stringresponse');
  }   }
 # foreach my $ans (@answers) {   foreach my $name (keys(%answer)) {
     if ($target eq 'answer') {      my @answers = @{ $answer{$name}{'answers'} };
  $result.=&Apache::response::answer_part('stringresponse',$answer);      for (my $i=0;$i<=$#answers;$i++) {
     } elsif ($target eq 'analyze') {   my $answer_part = $answers[$i];
  push (@{ $Apache::lonhomework::analyze{"$part.$id.answer"} },   foreach my $element (@{$answer_part}) {
       $answer);      if ($target eq 'answer') {
    $result.=&Apache::response::answer_part('stringresponse',
    $element);
       } elsif ($target eq 'analyze') {
    push (@{ $Apache::lonhomework::analyze{"$part.$id.answer"}{$name}[$i] },
         $element);
       }
    }
    if ($target eq 'answer' && $type eq 're') {
       $result.=&Apache::response::answer_part('stringresponse',
       $answerdisplay);
    }
     }      }
 # }   }
  my $string='Case Insensitive';   my $string='Case Insensitive';
  if ($type eq 'mc') {   if ($type eq 'mc') {
     $string='Multiple Choice';      $string='Multiple Choice';
Line 683  sub end_stringresponse { Line 1061  sub end_stringresponse {
     $string='Regular Expression';      $string='Regular Expression';
  }   }
  if ($target eq 'answer') {   if ($target eq 'answer') {
     if ($ENV{'form.answer_output_mode'} eq 'tex') {      if ($env{'form.answer_output_mode'} eq 'tex') {
  $result.=&Apache::response::answer_part('stringresponse',   $result.=&Apache::response::answer_part('stringresponse',
  "$string");   "$string");
     } else {      } else {
Line 702  sub end_stringresponse { Line 1080  sub end_stringresponse {
     }      }
     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);   &Apache::lonxml::increment_counter(&Apache::response::repetition());
     }      }
     &Apache::response::end_response;      &Apache::response::end_response;
     return $result;      return $result;
Removed from v.1.141  
changed lines
  Added in v.1.201

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.