Diff for /loncom/homework/caparesponse/caparesponse.pm between versions 1.181 and 1.185

version 1.181, 2005/11/16 22:52:31 version 1.185, 2005/12/06 10:16:56
Line 76  sub end_answergroup { Line 76  sub end_answergroup {
 }  }
   
 sub start_value {  sub start_value {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result;      my $result;
     if ( $target eq 'web' || $target eq 'tex' ||      if ( $target eq 'web' || $target eq 'tex' ||
  $target eq 'grade' || $target eq 'webgrade' ||   $target eq 'grade' || $target eq 'webgrade' ||
  $target eq 'answer' || $target eq 'analyze' ) {   $target eq 'answer' || $target eq 'analyze' ) {
  my $bodytext = &Apache::lonxml::get_all_text("/value",$parser);   my $bodytext = &Apache::lonxml::get_all_text("/value",$parser,$style);
  $bodytext = &Apache::run::evaluate($bodytext,$safeeval,   $bodytext = &Apache::run::evaluate($bodytext,$safeeval,
    $$parstack[-1]);     $$parstack[-1]);
  push(@{ $answer{$cur_name}{'answers'} },$bodytext);   push(@{ $answer{$cur_name}{'answers'} },$bodytext);
Line 96  sub end_value { Line 96  sub end_value {
 }  }
   
 sub start_array {  sub start_array {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result;      my $result;
     if ( $target eq 'web' || $target eq 'tex' ||      if ( $target eq 'web' || $target eq 'tex' ||
  $target eq 'grade' || $target eq 'webgrade' ||   $target eq 'grade' || $target eq 'webgrade' ||
  $target eq 'answer' || $target eq 'analyze' ) {   $target eq 'answer' || $target eq 'analyze' ) {
  my $bodytext = &Apache::lonxml::get_all_text("/value",$parser);   my $bodytext = &Apache::lonxml::get_all_text("/array",$parser,$style);
  my @values = &Apache::run::evaluate($bodytext,$safeeval,   my @values = &Apache::run::evaluate($bodytext,$safeeval,
     $$parstack[-1]);      $$parstack[-1]);
  push(@{ $answer{$cur_name}{'answers'} },@values);   push(@{ $answer{$cur_name}{'answers'} },@values);
Line 300  sub end_numericalresponse { Line 300  sub end_numericalresponse {
  &Apache::lonxml::debug($$parstack[-1] . "\n<br>");   &Apache::lonxml::debug($$parstack[-1] . "\n<br>");
   
  if ( &Apache::response::submitted('scantron')) {   if ( &Apache::response::submitted('scantron')) {
     my $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);  
     my (@answers)=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval);  
     my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack,$safeeval);  
     if ($#incorrect eq 0) { @incorrect=(split(/,/,$incorrect[0])); }  
     my ($values,$display)=&make_numerical_bubbles($number_of_bubbles,$target,$answers[0],$formats[0],\@incorrect,$safeeval);  
     $response=$values->[$response];      $response=$values->[$response];
  }   }
  $Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response;   $Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response;
Line 339  sub end_numericalresponse { Line 334  sub end_numericalresponse {
  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::lonhomework::type eq 'exam') {   if ($Apache::lonhomework::type eq 'exam') {
     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);  
     if ($#incorrect eq 0) { @incorrect=(split(/,/,$incorrect[0])); }  
     my ($bubble_values,$bubble_display)=  
  &make_numerical_bubbles($number_of_bubbles,  
  $target,$answers[0],  
  $formats[0],\@incorrect,$safeeval);  
     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 437  sub end_numericalresponse { Line 422  sub end_numericalresponse {
   
  if ($target eq 'answer') {   if ($target eq 'answer') {
     $result.=&Apache::response::answer_header($tag);      $result.=&Apache::response::answer_header($tag);
       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);
       }
  }   }
  my ($sigline,$tolline);   my ($sigline,$tolline);
  for(my $i=0;$i<=$#answers;$i++) {   for(my $i=0;$i<=$#answers;$i++) {
Line 517  sub end_numericalresponse { Line 508  sub end_numericalresponse {
  if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {   if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') {
     my $error;      my $error;
     if ($tag eq 'formularesponse') {      if ($tag eq 'formularesponse') {
  $error=&mt('Computer\'s answer is incorrect ("[_1]").');   $error=&mt('Computer\'s answer is incorrect ("[_1]").',$response);
     } else {      } else {
  # answer failed check if it is sig figs that is failing   # answer failed check if it is sig figs that is failing
  my ($ad,$msg)=&check_submission($response,$partid,$id,   my ($ad,$msg)=&check_submission($response,$partid,$id,
Line 629  sub format_number { Line 620  sub format_number {
 }  }
   
 sub make_numerical_bubbles {  sub make_numerical_bubbles {
     my ($number_of_bubbles,$target,$answer,$format,$incorrect,$safeeval) =@_;      my ($part,$id,$target,$parstack,$safeeval) =@_;
       
       my $number_of_bubbles = 
    &Apache::response::get_response_param($part.'_'.$id,'numbubbles',8);
   
       my ($format)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval);
       my ($answer)=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval);
       my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack,
      $safeeval);
       if ($#incorrect eq 0) { @incorrect=(split(/,/,$incorrect[0])); }
       
     my @bubble_values=();      my @bubble_values=();
     &Apache::lonxml::debug("answer is $answer incorrect is $incorrect");      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;   my @bubble_display;
  foreach my $value (@bubble_values) {   foreach my $value (@bubble_values) {
     push(@bubble_display,      push(@bubble_display,
  &format_number($value,$format,$target,$safeeval));   &format_number($value,$format,$target,$safeeval));
  }   }
  return (\@bubble_values,\@bubble_display);   return (\@bubble_values,\@bubble_display,$correct);
     } else {      } else {
  return (\@bubble_values,\@bubble_values);   return (\@bubble_values,\@bubble_values,$correct);
     }      }
  }   }
  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 (".join(',',@$incorrect).").");      &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 674  sub make_numerical_bubbles { Line 686  sub make_numerical_bubbles {
        $format,$target,$safeeval);         $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,\@bubble_display);      return (\@bubble_values,\@bubble_display,$correct);
 }  }
   
 sub get_tolrange {  sub get_tolrange {

Removed from v.1.181  
changed lines
  Added in v.1.185


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