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

Diff for /loncom/homework/default_homework.lcpm between versions 1.157 and 1.169

version 1.157, 2011/06/08 01:39:28 version 1.169, 2014/06/25 16:50:51
Line 143  sub caparesponse_check { Line 143  sub caparesponse_check {
     my $sig_lbound=''; #done      my $sig_lbound=''; #done
     my $sig_ubound=''; #done      my $sig_ubound=''; #done
   
   
     #type's definitons come from capaParser.h      #type's definitons come from capaParser.h
   
     #remove leading and trailing whitespace      #remove leading and trailing whitespace
Line 152  sub caparesponse_check { Line 151  sub caparesponse_check {
     }      }
     if ($response=~ /^\s|\s$/) {      if ($response=~ /^\s|\s$/) {
  $response=~ s:^\s+|\s+$::g;   $response=~ s:^\s+|\s+$::g;
  &LONCAPA_INTERNAL_DEBUG("Removed ws now :$response:");  
     }      }
   
     #&LONCAPA_INTERNAL_DEBUG(" type is $type ");  
     if ($type eq 'cs' || $type eq 'ci') {      if ($type eq 'cs' || $type eq 'ci') {
  #for string answers make sure all places spaces occur, there is    #for string answers make sure all places spaces occur, there is 
         #really only 1 space, in both the answer and the response          #really only 1 space, in both the answer and the response
Line 179  sub caparesponse_check { Line 176  sub caparesponse_check {
     if (length($response) > 500) { return ('TOO_LONG',undef); }      if (length($response) > 500) { return ('TOO_LONG',undef); }
   
     if ($type eq '' ) {      if ($type eq '' ) {
  &LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting");  
  if ( $answer eq ($answer *1.0)) { $type = 2;   if ( $answer eq ($answer *1.0)) { $type = 2;
       } else { $type = 3; }        } else { $type = 3; }
     } else {      } else {
Line 199  sub caparesponse_check { Line 195  sub caparesponse_check {
     #formula type setup the sample points      #formula type setup the sample points
     if ($type eq '8') {      if ($type eq '8') {
  ($id_list,$points)=split(/@/,$samples);   ($id_list,$points)=split(/@/,$samples);
  &LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples");  
     }      }
     if ($tol eq '') {      if ($tol eq '') {
  $tol=0.0;   $tol=0.0;
Line 258  sub caparesponse_check { Line 253  sub caparesponse_check {
     elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; }      elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; }
     else  {$result = "ERROR: Unknown Result:$result:$@:";}      else  {$result = "ERROR: Unknown Result:$result:$@:";}
   
     &LONCAPA_INTERNAL_DEBUG("RetError $reterror: Answer $answer: Response $response:  type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|");  
     &LONCAPA_INTERNAL_DEBUG(" $answer $response $result ");  
     return ($result,$reterror);      return ($result,$reterror);
 }  }
   
Line 310  sub caparesponse_check_list { Line 303  sub caparesponse_check_list {
  }   }
     }      }
   
     &LONCAPA_INTERNAL_DEBUG("Initial final response :$responses->[0][-1]:");  
     my $unit;      my $unit;
     my ($allowalgebra)=(&parameter_setting('allowalgebra',&currentpart())=~/^(yes|1|on)$/i);      my ($allowalgebra)=($LONCAPA::CAPAresponse_args{'allowalgebra'}=~/^(yes|1|on)$/i);
     if ($type eq 'float' || $type eq '') {      if ($type eq 'float' || $type eq '') {
  #for numerical problems split off the unit   #for numerical problems split off the unit
         my $part1;          my $part1;
Line 325  sub caparesponse_check_list { Line 317  sub caparesponse_check_list {
         if (defined($part1) && defined($part2)) {          if (defined($part1) && defined($part2)) {
     $responses->[0][-1]=$part1;      $responses->[0][-1]=$part1;
     $unit=&capa_formula_fix($part2);      $unit=&capa_formula_fix($part2);
             &LONCAPA_INTERNAL_DEBUG("Found unit :$unit:");              my $customunits=$LONCAPA::CAPAresponse_args{'customunits'};
               if ($customunits =~ /\S/) {
                   foreach my $replacement (split(/\s*\,\s*/,$customunits)) {
                       my ($which,$what)=split(/\s*\=\s*/,$replacement);
                       if ((defined($which)) && (defined($what))) {
                           $what=&capa_formula_fix($what);
                           $unit=~s/$which/\($what\)/g;
                       }
                   }
               }
  }   }
     }      }
     &LONCAPA_INTERNAL_DEBUG("Final final response :$responses->[0][-1]:$unit:");  
     $unit=~s/\s//;      $unit=~s/\s//;
     my $error;      my $error;
     foreach my $response (@$responses) {      foreach my $response (@$responses) {
Line 337  sub caparesponse_check_list { Line 337  sub caparesponse_check_list {
           if ($preprocess=~/\S/) {            if ($preprocess=~/\S/) {
              if (defined(&$preprocess)) {               if (defined(&$preprocess)) {
                 no strict 'refs';                  no strict 'refs';
                 $element=&$preprocess($element);                  $element=&$preprocess($element,$unit);
                 use strict 'refs';                  use strict 'refs';
              }               }
           }            }
Line 359  sub caparesponse_check_list { Line 359  sub caparesponse_check_list {
              $appendunit='%'.$appendunit;               $appendunit='%'.$appendunit;
           }            }
 # Zero does not need a dimension  # Zero does not need a dimension
           if (($element==0) && ($unit!~/\w/) && ($answerunit=~/\w/)) {            if (($element =~ /^[0\.]+$/) && ($unit!~/\w/) && ($answerunit=~/\w/)) {
              $appendunit=$answerunit;               $appendunit=$answerunit;
           }            }
 # Do the math for the student if allowed  # Do the math for the student if allowed
Line 414  sub caparesponse_check_list { Line 414  sub caparesponse_check_list {
                         }                            }  
                     }                      }
                 }                  }
                   # See if we have preprocessor for string responses
                   if (($preprocess=~/\S/) && ($type eq 'cs' || $type eq 'ci'))  {
                       if (defined(&$preprocess)) {
                           no strict 'refs';
                           $response->[$j]=&$preprocess($response->[$j]);
                           use strict 'refs';
                       }
                   }
   
  my ($award,$msg) = &caparesponse_check($answer->[$j],   my ($award,$msg) = &caparesponse_check($answer->[$j],
        $response->[$j]);         $response->[$j]);
                 if ($type eq 'cs' || $type eq 'ci') {                  if ($type eq 'cs' || $type eq 'ci') {
Line 452  sub caparesponse_check_list { Line 461  sub caparesponse_check_list {
                                 }                                  }
                             }                              }
                         }                          }
                           # See if we have preprocessor
                           if (($preprocess=~/\S/) && ($type eq 'cs' || $type eq 'ci')) {
                               if (defined(&$preprocess)) {
                                   no strict 'refs';
                                   $response->[$j]=&$preprocess($response->[$j]);
                                   use strict 'refs';
                               }
                           }
   
  my ($award,$msg) = &caparesponse_check($answer->[$j],   my ($award,$msg) = &caparesponse_check($answer->[$j],
        $response->[$j]);         $response->[$j]);
                         if ($type eq 'cs' || $type eq 'ci') {                          if ($type eq 'cs' || $type eq 'ci') {
Line 798  sub cos { CORE::cos(shift) } Line 816  sub cos { CORE::cos(shift) }
 sub exp { CORE::exp(shift) }  sub exp { CORE::exp(shift) }
 sub int { CORE::int(shift) }  sub int { CORE::int(shift) }
 sub log { CORE::log(shift) }  sub log { CORE::log(shift) }
   sub ln { CORE::log(shift) }
 sub atan2 { CORE::atan2($_[0],$_[1]) }  sub atan2 { CORE::atan2($_[0],$_[1]) }
 sub sqrt { CORE::sqrt(shift) }  sub sqrt { CORE::sqrt(shift) }
   
Line 1024  sub format_significant_figures { Line 1043  sub format_significant_figures {
     my ($zeros) = ($xint =~ /(0+)$/);      my ($zeros) = ($xint =~ /(0+)$/);
     # return number to original magnitude      # return number to original magnitude
     my $numSig = $xint*10**($x10-$sig+$power);      my $numSig = $xint*10**($x10-$sig+$power);
     # insert trailing zero's if have decimal point      if ($numSig =~ /^(\d+)\.(\d+)/) {
     $numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/;          # insert trailing zero's if have decimal point
     # put a decimal pt for number ending with 0 and length = # of sig fig          my @digarray = split('',$1.$2);
     $numSig.='.' if (length($numSig) == $sig && $numSig =~ /0$/);          my $sigcount;
     if (length($numSig) < $sig) {          while (@digarray > 0) {
  $numSig.='.'.substr($zeros,0,($sig-length($numSig)));              my $item = shift(@digarray);
               if ($item) {
                   $sigcount = 1 + @digarray;
                   last;
               }
           }
           if (($sigcount) && ($sig >= $sigcount)) {
               $zeros = substr($zeros,0,($sig - $sigcount));
           }
           $numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/;
       } else {
           if ($numSig =~ /^(\d+)e([\+\-]\d+)$/i) {
               my $pre_exp = $1;
               my $exponent = $2;
               $numSig = $pre_exp.'.'.$zeros.'E'.$exponent;
           } elsif ($numSig =~ /0$/) {
               # add decimal pt for number ending with 0 and length == # of sig figs
               if (length($numSig) == $sig) {
                   $numSig.='.';
               } elsif (length($numSig) > $sig) {
                   # exponential form for number ending with 0 and length > # of sig figs
                   my $fmtsig = $sig-1;
                   if ($fmtsig) {
                       $numSig = sprintf('%.'.$fmtsig.'E',$numSig);
                   }
               } elsif (length($numSig) < $sig) {
                   $numSig.='.'.substr($zeros,0,($sig-length($numSig)));
               }
           } else {
               if (length($numSig) < $sig) {
                   $numSig.='.'.substr($zeros,0,($sig-length($numSig)));
               }
           }
     }      }
     # return number with sign      # return number with sign
     return $sign.$numSig;      return $sign.$numSig;
   
 }  }
   
 sub map {  sub map {
Line 1165  sub middlename { Line 1215  sub middlename {
     return $middlename;      return $middlename;
 }  }
   
                                                                                   
 sub lastname {  sub lastname {
     my $lastname = &EXT('environment.lastname');      my $lastname = &EXT('environment.lastname');
     $lastname = '' if $lastname eq "";      $lastname = '' if $lastname eq "";
Line 1179  sub sec { Line 1228  sub sec {
 }  }
   
 sub submission {  sub submission {
    my ($partid,$responseid,$subnumber)=@_;     my ($partid,$responseid,$subnumber,$encode,$cleanupnum)=@_;
    my $sub='';     my $sub='';
    if ($subnumber) { $sub=$subnumber.':'; }     if ($subnumber) { $sub=$subnumber.':'; }
    return &EXT('user.resource.'.$sub.'resource.'.$partid.'.'.$responseid.'.submission');     my $output =
          &EXT('user.resource.'.$sub.'resource.'.$partid.'.'.$responseid.'.submission');
      if (ref($output) eq 'ARRAY') {
          my @items = @{$output};
          if ($encode) {
              @items = map { &encode_response($_); } @items;
          }
          if (ref($cleanupnum) eq 'HASH') {
              @items = map { &cleanup_numerical_response($cleanupnum,$_); } @items;
          }
          return \@items;
      } else {
          if ($encode) {
              $output = &encode_response($output);
          }
          if (ref($cleanupnum) eq 'HASH') {
              $output = &cleanup_numerical_response($cleanupnum,$output);
          }
          return $output;
      }
   }
   
   sub encode_response {
       my ($value) = @_;
       $value =~ s/&/&amp;/g;
       $value =~ s/</&lt;/g;
       $value =~ s/>/&gt;/g;
       $value =~ s/"/&quot;/g;
       return $value;
   }
   
   sub cleanup_numerical_response {
       my ($cleanupnum,$value) = @_;
       if (ref($cleanupnum) eq 'HASH') {
           if ($cleanupnum->{exponent}) {
               if ($value =~ m{^(.*)[\*xX]\s*10\s*\^\s*(\+|\-)?\s*(\d+)(.*)$}) {
                   my $pre_exp = $1;
                   my $sign = $2;
                   my $exponent = $3;
                   my $post_exp = $4;
                   if ($pre_exp !~ /\./) {
                       $pre_exp .= '.';
                   }
                   if ($sign eq '') {
                       $sign = '+';
                   }
                   $value = $pre_exp.'E'.$sign.$exponent.$post_exp;
               }
           }
           if ($cleanupnum->{comma}) {
               $value =~ s{(\d+),(\d+)}{$1$2};
           }
           if ($cleanupnum->{letterforzero}) {
               $value =~ s/^\s*o(\.\d+)/0$1/i;
           }
           if ($cleanupnum->{spaces}) {
               $value =~ s{^\s+|\s+$}{}g;
               if ($value =~ m{^(.*)\.\s+(\d+)(.*)$}) {
                   my $pre_pt = $1;
                   my $decimal = $2;
                   my $post_dec = $3;
                   $value = $pre_pt.'.'.$decimal.$post_dec;
               }
           }
           if ($cleanupnum->{format} =~ /^\d+s$/i) {
               $value = &format_significant_figures($value,$cleanupnum->{format});
           }
       }
       return $value;
 }  }
   
 sub currentpart {  sub currentpart {
Removed from v.1.157  
changed lines
  Added in v.1.169

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.