[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.73 and 1.111

version 1.73, 2004/03/16 15:31:52 version 1.111, 2006/07/18 14:06:17
Line 26 Line 26
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 #  #
 # Guy Albertelli  
 #  
 # 05/25/2001 H. K. Ng  
 # 05/31/2001 H. K. Ng  
 # 12/21/2001 Matthew  
 #  
 #init some globals  #init some globals
 $hidden::RANDOMINIT=0;  $hidden::RANDOMINIT=0;
 $pi=atan2(1,1)*4;  $pi=atan2(1,1)*4;
Line 39  $rad2deg=180.0/$pi; Line 34  $rad2deg=180.0/$pi;
 $deg2rad=$pi/180.0;  $deg2rad=$pi/180.0;
 $"=' ';  $"=' ';
   
   sub check_commas {
       my ($response)=@_;
       #print("$response ");
       my @numbers=split(',',$response);
       #print(" numbers ".join('-',@numbers)." ");
       if (scalar(@numbers) > 1) {
           #print(" numbers[0] ".$numbers[0]." "); 
    if (length($numbers[0]) > 3 || length($numbers[0]) == 0) { return -1; }
    shift(@numbers);
    #print(" numbers ".scalar(@numbers)." ");
    while (scalar(@numbers) > 1) {
       #print(" numbers ".join('-',@numbers)." ");
       if (length($numbers[0]) != 3) { return -2; }
       shift(@numbers);
    }
    my ($number)=split('\.',$numbers[0]);
    #print(" number ".$number." ");
    #print(" numbers[0] ".$numbers[0]." ");
    if (length($number) != 3) { return -3; }
       } else {
    my ($number)=split('\.',$numbers[0]);
    if (length($number) > 3) { return -4; }
       }
       return 1;
   }
   
 sub caparesponse_check {  sub caparesponse_check {
       my ($answer,$response)=@_;
     #not properly used yet: calc      #not properly used yet: calc
     #not to be used: $ans_fmt      #not to be used: $ans_fmt
     my ($type,$tol,$sig,$ans_fmt,$unit,$calc,$samples) =      my $type=$LONCAPA::CAPAresponse_args{'type'};
  eval $_[2].      my $tol=$LONCAPA::CAPAresponse_args{'tol'};
  ';return ($__LC__type,$__LC__tol,$__LC__sig,$__LC__ans_fmt,$__LC__unit,$__LC__calc,$__LC__samples);';      my $sig=$LONCAPA::CAPAresponse_args{'sig'};
       my $ans_fmt=$LONCAPA::CAPAresponse_args{'format'};
       my $unit=$LONCAPA::CAPAresponse_args{'unit'};
       my $calc=$LONCAPA::CAPAresponse_args{'calc'};
       my $samples=$LONCAPA::CAPAresponse_args{'samples'};
           
     my $tol_type=''; # gets it's value from whether tol has a % or not done      my $tol_type=''; # gets it's value from whether tol has a % or not done
     my $sig_lbound=''; #done      my $sig_lbound=''; #done
     my $sig_ubound=''; #done      my $sig_ubound=''; #done
     my ($answer,$response,$expr)=@_;  
   
   
     #type's definitons come from capaParser.h      #type's definitons come from capaParser.h
Line 64  sub caparesponse_check { Line 89  sub caparesponse_check {
     } else {      } else {
  $message .="no ws in :$response:\n";   $message .="no ws in :$response:\n";
     }      }
       &LONCAPA_INTERNAL_DEBUG(" type is $type ");
       if ($type eq 'cs' || $type eq 'ci') {
    #for string answers make surec all places spaces occur, there is 
           #really only 1 space, in both the answer and the response
    $answer=~s/ +/ /g;
    $response=~s/ +/ /g;
       } elsif ($type eq 'mc') {
    $answer=~s/[\s,]//g;
    $response=~s/[\s,]//g;
       }
       if ($type eq 'float' && $unit=~/\$/) {
    if ($response!~/^\$/)  { return "NO_UNIT: Missing \$ "; }
    $response=~s/\$//g;
       }
       if ($type eq 'float' && $unit=~/\,/ && (&check_commas($response)<0)) {
    return "COMMA_FAIL:";
       }
       $ans_fmt=~s/\W//g;
       $unit=~s/[\$,]//g;
       if ($type eq 'float') { $response=~s/,//g; }
   
     if (length($response) > 500) { return "TOO_LONG: Answer too long"; }      if (length($response) > 500) { return "TOO_LONG: Answer too long"; }
   
     if ($type eq '' ) {      if ($type eq '' ) {
  $message .= "Didn't find a type :$type:$expr: defaulting\n";   $message .= "Didn't find a type :$type: defaulting\n";
  if ( $answer eq ($answer *1.0)) { $type = 2;   if ( $answer eq ($answer *1.0)) { $type = 2;
       } else { $type = 3; }        } else { $type = 3; }
     } else {      } else {
  if ($type eq 'cs')    { $type = 4; }   if    ($type eq 'cs')    { $type = 4; }
  elsif ($type eq 'ci')    { $type = 3 }   elsif ($type eq 'ci')    { $type = 3 }
  elsif ($type eq 'mc')    { $type = 5; }   elsif ($type eq 'mc')    { $type = 5; }
  elsif ($type eq 'fml')   { $type = 8; }   elsif ($type eq 'fml')   { $type = 8; }
           elsif ($type eq 'math')  { $type = 9; }
  elsif ($type eq 'subj')  { $type = 7; }   elsif ($type eq 'subj')  { $type = 7; }
  elsif ($type eq 'float') { $type = 2; }   elsif ($type eq 'float') { $type = 2; }
  elsif ($type eq 'int')   { $type = 1; }   elsif ($type eq 'int')   { $type = 1; }
Line 101  sub caparesponse_check { Line 147  sub caparesponse_check {
  }   }
     }      }
   
     if ($sig eq '') {      ($sig_ubound,$sig_lbound)=&LONCAPA_INTERNAL_get_sigrange($sig);
  $sig_lbound = 0; #SIG_LB_DEFAULT  
  $sig_ubound =15; #SIG_UB_DEFAULT  
     } else {  
  ($sig_lbound,$sig_ubound) = split /,/,$sig;  
  if (!defined($sig_lbound)) {  
     $sig_lbound = 0; #SIG_LB_DEFAULT  
     $sig_ubound =15; #SIG_UB_DEFAULT  
  }  
  if (!defined($sig_ubound)) { $sig_ubound=$sig_lbound; }  
     }  
     my $reterror="";      my $reterror="";
     my $result = &caparesponse_capa_check_answer($response,$answer,$type,      my $result;
       if ($type eq '9') {
         $result = &maxima_check(&maxima_cas_formula_fix($response),&maxima_cas_formula_fix($answer),\$reterror);
       } else {
    if ($type eq '8') { # fml type
       $response = &capa_formula_fix($response);
       $answer   = &capa_formula_fix($answer);
    }
          $result = &caparesponse_capa_check_answer($response,$answer,$type,
  $tol_type,$tol,   $tol_type,$tol,
  $sig_lbound,$sig_ubound,   $sig_lbound,$sig_ubound,
  $ans_fmt,$unit,$calc,$id_list,   $ans_fmt,$unit,$calc,$id_list,
  $points,$external::randomseed,   $points,$external::randomseed,
  \$reterror);   \$reterror);
       }
     if    ($result == '1') { $result='EXACT_ANS'; }       if    ($result == '1') { $result='EXACT_ANS'; } 
     elsif ($result == '2') { $result='APPROX_ANS'; }      elsif ($result == '2') { $result='APPROX_ANS'; }
     elsif ($result == '3') { $result='SIG_FAIL'; }      elsif ($result == '3') { $result='SIG_FAIL'; }
Line 131  sub caparesponse_check { Line 176  sub caparesponse_check {
     elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; }      elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; }
     elsif ($result =='10') { $result='SUB_RECORDED'; }      elsif ($result =='10') { $result='SUB_RECORDED'; }
     elsif ($result =='11') { $result='BAD_FORMULA'; }      elsif ($result =='11') { $result='BAD_FORMULA'; }
       elsif ($result =='12' && !$response) { $result='MISSING_ANSWER'; }
     elsif ($result =='12') { $result='WANTED_NUMERIC'; }      elsif ($result =='12') { $result='WANTED_NUMERIC'; }
       elsif ($result =='13') { $result='UNIT_INVALID_INSTRUCTOR'; }
       elsif ($result =='141') { $result='UNIT_INVALID_STUDENT'; }
       elsif ($result =='142') { $result='UNIT_INVALID_STUDENT'; }
       elsif ($result =='143') { $result='UNIT_INVALID_STUDENT'; }
       elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; }
     else  {$result = "ERROR: Unknown Result:$result:$@:";}      else  {$result = "ERROR: Unknown Result:$result:$@:";}
   
     return ("$result:\nRetError $reterror:\nError $error:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message$expr",$reterror);      return ("$result:\nRetError $reterror:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message",$reterror);
 }  }
   
   sub maxima_cas_formula_fix {
      my ($expression)=@_;
      return &implicit_multiplication($expression);
   }
   
   sub capa_formula_fix {
      my ($expression)=@_;
      return &implicit_multiplication($expression);
   }
   
   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
       $expression=~s/\s+/\*/gs;
   # 3a -> 3*a; 3( -> 3*(; 3A -> 3*a
       $expression=~s/(\d)([a-zA-Z\(])/$1\*$2/gs;
   # a3 -> a*3; )3 -> )*3
       $expression=~s/([a-zA-Z])(\d)/$1\*$2/gs;
   # )a -> )*a
       $expression=~s/\)(\w)/\)\*$1/gs;
   # 3&8 -> 3e8; 3&-4 -> 3e-4
       $expression=~s/(\d+)\&\(([\+\-]*\d+)\)/$1e$2/gs;
       return $expression;
   }
   
 sub caparesponse_check_list {  sub caparesponse_check_list {
     my ($response,$expr)=@_;      my $response=$LONCAPA::CAPAresponse_args{'response'};
     my ($result,@list);      my $result="Got response :".join(':',@LONCAPA::CAPAresponse_answer).":\n";
     @list=@CAPARESPONSE_CHECK_LIST_answer;      &LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args));
     my $aresult='';  
     my $current_answer;  
     my $answers=join(':',@list);  
     $result.="Got response :$answers:\n";  
     my @responselist;      my @responselist;
     my $type =eval $expr.';return $__LC__type;';      my $type = $LONCAPA::CAPAresponse_args{'type'};
     $result.="Got type :$type:\n";      $result.="Got type :$type:\n";
     if ($type ne '' && $#list > 0) {      if ($type ne '' && $#LONCAPA::CAPAresponse_answer > 0) {
  (@responselist)=split /,/,$response;   (@responselist)=split(/,/,$response);
    if (@responselist < @LONCAPA::CAPAresponse_answer) {
       return 'MISSING_ANSWER';
    }
    if (@responselist > @LONCAPA::CAPAresponse_answer) {
       return 'EXTRA_ANSWER';
    }
     } else {      } else {
  (@responselist)=($response);   (@responselist)=($response);
     }      }
     my $unit='';  
     $result.="Initial final response :$responselist['-1']:\n";      $result.="Initial final response :$responselist['-1']:\n";
       my $unit;
     if ($type eq '' || $type eq 'float') {      if ($type eq '' || $type eq 'float') {
  #for numerical problems split off the unit   #for numerical problems split off the unit
  if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) {   if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) {
Line 163  sub caparesponse_check_list { Line 246  sub caparesponse_check_list {
     $unit=$2;      $unit=$2;
  }   }
     }      }
     $result.="Final final response :$responselist['-1']:\n";      $result.="Final final response :$responselist['-1']:$unit:\n";
     $result.=":$#list: answers\n";  
     $unit=~s/\s//;      $unit=~s/\s//;
     my $i=0;  
     my $awards='';      my ($awards, @msgs, $i);
     my @msgs;      foreach my $thisanswer (@LONCAPA::CAPAresponse_answer) {
     for ($i=0; $i<@list;$i++) {   my ($msg,$aresult);
  my $msg;  
  $result.="trying answer :$list[$i]:\n";  
  my $thisanswer=$list[$i];  
  $result.="trying answer :$thisanswer:\n";   $result.="trying answer :$thisanswer:\n";
  if ($unit eq '') {   if (defined($thisanswer)) {
     ($aresult,$msg)=&caparesponse_check($thisanswer,$responselist[$i],      if ($unit eq '') {
  $expr);   ($aresult,$msg)=&caparesponse_check($thisanswer,
       $responselist[$i]);
       } else {
    ($aresult,$msg)=&caparesponse_check($thisanswer,
       $responselist[$i]." $unit");
       }
  } else {   } else {
     ($aresult,$msg)=&caparesponse_check($thisanswer,      $aresult='ERROR';
  $responselist[$i]." $unit",      $msg='answer was undefined';
  $expr);  
  }   }
  my ($temp)=split /:/, $aresult;   &LONCAPA_INTERNAL_DEBUG("after if $aresult -- $msg");
    my ($temp)=split(/:/, $aresult);
  $awards.="$temp,";   $awards.="$temp,";
  $result.=$aresult;   $result.=$aresult;
  push(@msgs,$msg);   push(@msgs,$msg);
    $i++;
     }      }
     chop $awards;      chop($awards);
     return ("$awards:\n$result",@msgs);      return ("$awards:\n$result",@msgs);
 }  }
   
Line 234  sub random { Line 319  sub random {
     if ( ! $hidden::RANDOMINIT ) {      if ( ! $hidden::RANDOMINIT ) {
  if ($external::randomseed == 0) { $external::randomseed=1; }   if ($external::randomseed == 0) { $external::randomseed=1; }
  if ($external::randomseed =~/,/) {   if ($external::randomseed =~/,/) {
     my ($num1,$num2)=split(/,/,$seed);      my ($num1,$num2)=split(/,/,$external::randomseed);
       &random_set_seed(1,abs($num1));
    } elsif ($external::randomseed =~/:/) {
       my ($num1,$num2)=split(/:/,$external::randomseed);
     &random_set_seed(abs($num1),abs($num2));      &random_set_seed(abs($num1),abs($num2));
  } else {   } else {
     &random_set_seed(1,int(abs($external::randomseed)));      &random_set_seed(1,int(abs($external::randomseed)));
Line 342  sub random_multivariate_normal { Line 430  sub random_multivariate_normal {
     my ($item_cnt,$seed,$mean,$covar) = @_;      my ($item_cnt,$seed,$mean,$covar) = @_;
     my @oldseed=&random_get_seed();      my @oldseed=&random_get_seed();
     &random_set_seed_from_phrase($seed);      &random_set_seed_from_phrase($seed);
     @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar);      my @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar);
     &random_set_seed(@oldseed);      &random_set_seed(@oldseed);
     return @retArray;      return @retArray;
 }  }
Line 352  sub random_multinomial { Line 440  sub random_multinomial {
     my @oldseed=&random_get_seed();      my @oldseed=&random_get_seed();
     my @retArray;      my @retArray;
     &random_set_seed_from_phrase($seed);      &random_set_seed_from_phrase($seed);
     @retArray=&math_random_multinomial($item_cnt,@p);      my @retArray=&math_random_multinomial($item_cnt,@p);
     &random_set_seed(@oldseed);      &random_set_seed(@oldseed);
     return @retArray;      return @retArray;
 }  }
Line 407  sub random_negative_binomial { Line 495  sub random_negative_binomial {
     return @retArray;      return @retArray;
 }  }
   
 sub abs { abs(shift) }  sub abs { CORE::abs(shift) }
 sub sin { sin(shift) }  sub sin { CORE::sin(shift) }
 sub cos { cos(shift) }  sub cos { CORE::cos(shift) }
 sub exp { exp(shift) }  sub exp { CORE::exp(shift) }
 sub int { int(shift) }  sub int { CORE::int(shift) }
 sub log { log(shift) }  sub log { CORE::log(shift) }
 sub atan2 { atan2($_[0],$_[1]) }  sub atan2 { CORE::atan2($_[0],$_[1]) }
 sub sqrt { sqrt(shift) }  sub sqrt { CORE::sqrt(shift) }
   
 sub tan  { CORE::sin($_[0]) / CORE::cos($_[0]) }  sub tan  { CORE::sin($_[0]) / CORE::cos($_[0]) }
 #sub atan { atan2($_[0], 1); }  #sub atan { atan2($_[0], 1); }
Line 473  sub floor  {return (($_[0]-CORE::int($_[ Line 561  sub floor  {return (($_[0]-CORE::int($_[
   
 sub format {  sub format {
     my ($value,$fmt)=@_;      my ($value,$fmt)=@_;
     my $dollarmode;      my ($dollarmode,$commamode,$alwaysperiod,$options);
     if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; }       if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; } 
     $fmt=~s/e/E/g;      #if ($options =~ /\$/) { $dollamode=1; }
     my $result=sprintf('%.'.$fmt,$value);      #if ($options =~ /,/)  { $commamode=1; }
     $result=~s/(E[+-]*)0/$1/;      if ($options =~ /\./) { $alwaysperiod=1; }
     if ($dollarmode) {$result=&dollarmode($result);}      my $result;
       if ($fmt=~/s$/i) {
    $result=&format_significant_figures($value,$fmt);
       } else {
    $fmt=~s/e/E/g;
    $result=sprintf('%.'.$fmt,$value);
    if ($alwaysperiod && $fmt eq '0f') { $result .='.'; }
    $result=~s/(E[+-]*)0/$1/;
       }
       #if ($dollarmode) {$result=&dollarformat($result);}
       #if ($commamode) {$result=&commaformat($result);}
     return $result;      return $result;
 }  }
   
   sub chemparse {
       my ($reaction) = @_;
       my @tokens = split(/(\s\+|\->|<=>|<\-|\.)/,$reaction);
       my $formula = '';
       foreach my $token (@tokens) {
    if ($token eq '->' ) {
       $formula .= '<m>\ensuremath{\rightarrow}</m> ';
       next;
    }
    if ($token eq '<-' ) {
       $formula .= '<m>\ensuremath{\leftarrow}</m> ';
       next;
    }  
    if ($token eq '<=>') {
       if ($external::target eq 'web' &&
    &EXT('request.browser.unicode')) {
    $formula .= '&#8652; ';
       } else {
    $formula .= &web('<=> ','<m>\ensuremath{\rightleftharpoons}</m> ',
    '&lt;=&gt; ');
       }
       next;
    }
    if ($token eq '.') {
     $formula =~ s/(\&nbsp\;| )$//;
     $formula .= '&middot;';
     next;
    }
    $token =~ /^\s*([\d|\/]*(?:&frac\d\d)?)(.*)/;
           $formula .= $1 if ($1 ne '1');  # stoichiometric coefficient
   
    my $molecule = $2;
    # subscripts
    $molecule =~ s|(?<=[a-zA-Z\)\]\s])(\d+)|<sub>$1</sub>|g;
    # superscripts
    $molecule =~ s|\^(\d*[+\-]*)|<sup>$1</sup>|g;
    # strip whitespace
    $molecule =~ s/\s*//g;
    # forced space
    $molecule =~ s/_/ /g;
    $molecule =~ s/-/&minus;/g;
    $formula .= $molecule.'&nbsp;';
       }
       # get rid of trailing space
       $formula =~ s/(\&nbsp\;| )$//;
       return &xmlparse($formula);
   }
   
 sub prettyprint {  sub prettyprint {
     my ($value,$fmt,$target)=@_;      my ($value,$fmt,$target)=@_;
     my $result;      my $result;
     my $dollarmode;  
     if (!$target) { $target = $external::target; }      if (!$target) { $target = $external::target; }
     if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; }       if ($fmt =~ /chem/i) { return(&chemparse($value)); }
     if ($fmt) { $value=sprintf('%.'.$fmt,$value); }      my ($dollarmode,$commamode,$alwaysperiod,$options);
       if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; } 
       if ($options =~ /\$/) { $dollarmode=1; }
       if ($options =~ /,/)  { $commamode=1; }
       if ($options =~ /\./) { $alwaysperiod=1; }
       if ($fmt=~/s$/i) {
    $value=&format_significant_figures($value,$fmt);
       } elsif ($fmt) {
    $value=sprintf('%.'.$fmt,$value);
       }
       if ($alwaysperiod && $fmt eq '0f') {
    if ($target eq 'tex') {
       $value .='\\ensuremath{.}';
    } else {
       $value .='.';
    }
       }
     if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/i ) {      if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/i ) {
  my $frac=$1;   my $frac=$1;
  if ($dollarmode) { $frac=&dollarformat($frac); }   if ($dollarmode) { $frac=&dollarformat($frac); }
    if ($commamode) { $frac=&commaformat($frac); }
  my $exponent=$2;   my $exponent=$2;
  $exponent=~s/^\+0*//;   $exponent=~s/^\+0*//;
  $exponent=~s/^-0*/-/;   $exponent=~s/^-0*/-/;
Line 510  sub prettyprint { Line 672  sub prettyprint {
  }   }
     } else {      } else {
  $result=$value;   $result=$value;
  if ($dollarmode) { $result=&dollarformat($result,$target); }   if    ($dollarmode) { $result=&dollarformat($result,$target); }
    elsif ($commamode)  { $result=&commaformat($result,$target); }
     }      }
     return $result;      return $result;
 }  }
   
 sub dollarformat {  sub commaformat {
     my ($number,$target) = @_;      my ($number,$target) = @_;
     if (!$target) { $target = $external::target; }  
     if ($number =~ /\./) {      if ($number =~ /\./) {
  while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) {   while ($number =~ /([^0-9]*)([0-9]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) {
     $number = $1.','.$2.$3;      $number = $1.$2.','.$3.$4;
  }   }
     } else {      } else {
  while ($number =~ /([^,]+)([^,][^,][^,])([,0-9]*)$/) {   while ($number =~ /^([^0-9]*)([0-9]+)([^,][^,][^,])([,0-9]*)$/) {
     $number = $1.','.$2.$3;      $number = $1.$2.','.$3.$4;
  }   }
     }      }
       return $number;
   }
   
   sub dollarformat {
       my ($number,$target) = @_;
       if (!$target) { $target = $external::target; }
       $number=&commaformat($number,$target);
     if ($target eq 'tex') {      if ($target eq 'tex') {
  $number='\$'.$number; #' stupid emacs   $number='\$'.$number; #' stupid emacs
     } else {      } else {
Line 535  sub dollarformat { Line 704  sub dollarformat {
     return $number;       return $number; 
 }  }
   
   # format of form ns or nS where n is an integer
   sub format_significant_figures {
       my ($number,$format) = @_; 
       return '0' if ($number == 0);
       # extract number of significant figures needed
       my ($sig) = ($format =~ /(\d+)s/i);
       # arbitrary choice - suggestions ?? or throw error message?
       $sig = 3 if ($sig eq '');
       # save the minus sign
       my $sign = ($number < 0) ? '-' : '';
       $number = abs($number);
       # needed to correct for a number greater than 1 (or
       my $power = ($number < 1) ? 0 : 1;
       # could round up. Take the integer part of log10.
       my $x10 = int(log($number)/log(10));
       # find number with values left of decimal pt = # of sign figs.
       my $xsig = $number*10**($sig-$x10-$power);
       # get just digits left of decimal pt - also rounds off correctly
       my $xint  = sprintf('%.0f',$xsig);
       # save any trailing zero's
       my ($zeros) = ($xint =~ /(0+)$/);
       # return number to original magnitude
       my $numSig = $xint*10**($x10-$sig+$power);
       # insert trailing zero's if have decimal point
       $numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/;
       # put a decimal pt for number ending with 0 and length = # of sig fig
       $numSig.='.' if (length($numSig) == $sig && $numSig =~ /0$/);
       if (length($numSig) < $sig) {
    $numSig.='.'.substr($zeros,0,($sig-length($numSig)));
       }
       # return number with sign
       return $sign.$numSig;
   
   }
   
 sub map {  sub map {
     my ($phrase,$dest,$source)=@_;      my ($phrase,$dest,$source)=@_;
     my @oldseed=&random_get_seed();      my @oldseed=&random_get_seed();
Line 730  sub choose { Line 934  sub choose {
     return $_[$num];      return $_[$num];
 }  }
   
   #&sum1(1,$x,sub { &sum1($_[0],2*$_[0], sub { fact($_[0])**2 })});
   #sub sum1 {
   #    my ($start,$end,$sub)=@_;
   #    my $sum=0;
   #    for (my $i=$start;$i<=$end;$i++) {
   #        $sum+=&$sub($i);
   #    }
   #    return $sum
   #}
   
   #&sum2('a',1,$x,'&sum2(\'b\',$a,2*$a, \'&factorial($b)**2\')');
   #sub sum2 {
   #    my ($varname,$start,$end,$line)=@_;
   #    my $sum=0;
   #    for (my $i=$start;$i<=$end;$i++) {
   # my $func=sub {
   #    eval("\$".$varname."=$i");
   #    eval($line);
   # };
   #        $sum+=&$func($i);
   #    }
   #    return $sum
   #}
   
 # expiremental idea  # expiremental idea
 sub proper_path {  sub proper_path {
     my ($path)=@_;      my ($path)=@_;
Removed from v.1.73  
changed lines
  Added in v.1.111

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