File:  [LON-CAPA] / loncom / homework / default_homework.lcpm
Revision 1.64: download - view: text, annotated - select for diffs
Tue Jun 24 20:41:56 2003 UTC (20 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: version_1_0_3, version_1_0_2, version_1_0_1, version_1_0_0, version_0_99_5, version_0_99_4, version_0_99_3, HEAD
= BUG#1849, answers that are in arrays didn't work, now pass the answer in through a varglob into the safe space, and then through a parameter to the capa_check_answer function

# The LearningOnline Network with CAPA 
# used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
#
# $Id: default_homework.lcpm,v 1.64 2003/06/24 20:41:56 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#
# Guy Albertelli
#
# 05/25/2001 H. K. Ng
# 05/31/2001 H. K. Ng
# 12/21/2001 Matthew
#
#init some globals
$hidden::RANDOMINIT=0;
$pi=atan2(1,1)*4;
$rad2deg=180.0/$pi;
$deg2rad=$pi/180.0;
$"=' ';

sub caparesponse_check {
  #not properly used yet: calc
  #not to be used: $ans_fmt
  my ($type,$tol,$sig,$ans_fmt,$unit,$calc,$samples) =
    eval $_[2].
      ';return ($type,$tol,$sig,$ans_fmt,$unit,$calc,$samples);';

  my $tol_type=''; # gets it's value from whether tol has a % or not done
  my $sig_lbound=''; #done
  my $sig_ubound=''; #done
  my ($answer,$response,$expr)=@_;


  #type's definitons come from capaParser.h
  my $message='';
  #remove leading and trailing whitespace
  if ($response=~ /^\s|\s$/) {
    $response=~ s:^\s+|\s+$::g;
    $message .="Removed ws now :$response:\n";
  } else {
    $message .="no ws in :$response:\n";
  }

  if (length($response) > 500) { return "TOO_LONG: Answer too long"; }

  if ($type eq '' ) {
    $message .= "Didn't find a type :$type:$expr: defaulting\n";
    if ( $answer eq ($answer *1.0)) { $type = 2;
    } else { $type = 3; }
  } else {
         if ($type eq 'cs')    { $type = 4;
    } elsif ($type eq 'ci')    { $type = 3;
    } elsif ($type eq 'mc')    { $type = 5;
    } elsif ($type eq 'fml')   { $type = 8;
    } elsif ($type eq 'subj')  { $type = 7;
    } elsif ($type eq 'float') { $type = 2;
    } elsif ($type eq 'int')   { $type = 1;
    } else { return "ERROR: Unknown type of answer: $type" }
  }

  my $points;
  my $id_list;
  #formula type setup the sample points
  if ($type eq '8') {
    ($id_list,$points)=split(/@/,$samples);
    $message.="Found :$id_list:$points: points in $samples\n";
  }
  if ($tol eq '') {
    $tol=0.0;
    $tol_type=1; #TOL_ABSOLUTE
  } else {
    if ($tol =~ /%$/) {
      chop $tol;
      $tol_type=2; #TOL_PERCENTAGE
    } else {
      $tol_type=1; #TOL_ABSOLUTE
    }
  }

  if ($sig eq '') {
    $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 $result = &caparesponse_capa_check_answer($response,$answer,$type,
					       $tol_type,$tol,
					       $sig_lbound,$sig_ubound,
					       $ans_fmt,$unit,$calc,$id_list,
					       $points,$external::randomseed);

  if    ($result == '1') { $result='EXACT_ANS'; } 
  elsif ($result == '2') { $result='APPROX_ANS'; }
  elsif ($result == '3') { $result='SIG_FAIL'; }
  elsif ($result == '4') { $result='UNIT_FAIL'; }
  elsif ($result == '5') { $result='NO_UNIT'; }
  elsif ($result == '6') { $result='UNIT_OK'; }
  elsif ($result == '7') { $result='INCORRECT'; }
  elsif ($result == '8') { $result='UNIT_NOTNEEDED'; }
  elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; }
  elsif ($result =='10') { $result='SUB_RECORDED'; }
  elsif ($result =='11') { $result='BAD_FORMULA'; }
  elsif ($result =='12') { $result='WANTED_NUMERIC'; }
  else  {$result = "ERROR: Unknown Result:$result:$@:";}

  return "$result:\nError $error:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message$expr";
}

sub get_array_args {
  my ($expr,$arg)=@_;
  # do these first, because who knows what varname the instructor might have used
  # but it probably isn't $CAPARESPONSE_CHECK_LIST_answer
  my $CAPARESPONSE_CHECK_LIST_answer = eval $expr.';return $'.$arg; #' stupid emacs
  my $GET_ARRAY_ARGS_result="expr is $expr\narg is $arg\nfirst answer guess is $CAPARESPONSE_CHECK_LIST_answer\n";
  my @GET_ARRAY_ARGS_list;
  if ($CAPARESPONSE_CHECK_LIST_answer =~ /^\s*[\$\@]/) {
    (@GET_ARRAY_ARGS_list) = eval $CAPARESPONSE_CHECK_LIST_answer;
  }
  $GET_ARRAY_ARGS_result.="error:$@:\n";
  # if the eval fails just use what is in the answer exactly
  if (!(@GET_ARRAY_ARGS_list) || !defined($GET_ARRAY_ARGS_list[0])) {
    $GET_ARRAY_ARGS_result.="list zero is undefined\n";
    $GET_ARRAY_ARGS_list[0]=$CAPARESPONSE_CHECK_LIST_answer;
  }
  return $GET_ARRAY_ARGS_result,@GET_ARRAY_ARGS_list;
}

sub caparesponse_check_list {
  my ($response,$expr)=@_;
#  $expr =~ s/\\/\\\\/g;
#  $expr =~ s/\'/\\\'/g;
#  my ($result,@list) = &get_array_args($expr,'answer');
#  $expr =~ s/\\\'/\'/g;
#  $expr =~ s/\\\\/\\/g;
  my ($result,@list);
  @list=@CAPARESPONSE_CHECK_LIST_answer;
  my $aresult='';
  my $current_answer;
  my $answers=join(':',@list);
  $result.="Got response :$answers:\n";
  my @responselist;
  my $type =eval $expr.';return $type;';
  if ($type ne '' && $#list > 0) {
    (@responselist)=split /,/,$response;
  } else {
    (@responselist)=($response);
  }
  my $unit='';
  $result.="Initial final response :$responselist['-1']:\n";
  if ($type eq '' || $type eq 'float') {
    #for numerical problems split off the unit
    if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) {
      $responselist['-1']=$1;
      $unit=$2;
    }
  }
  $result.="Final final response :$responselist['-1']:\n";
  $result.=":$#list: answers\n";
  $unit=~s/\s//;
  my $i=0;
  my $awards='';
  for ($i=0; $i<@list;$i++) {
    $result.="trying answer :$list[$i]:\n";
    my $thisanswer=$list[$i];
#    $thisanswer=~ s/\\/\\\\/g;
#    $thisanswer =~ s/\'/\\\'/g;
    $result.="trying answer :$thisanswer:\n";
    if ($unit eq '') {
      $aresult=&caparesponse_check($thisanswer,$responselist[$i],
			     $expr);
    } else {
      $aresult=&caparesponse_check($thisanswer,$responselist[$i]." $unit",
				   $expr);
    }
    my ($temp)=split /:/, $aresult;
    $awards.="$temp,";
    $result.=$aresult;
  }
  chop $awards;
  return "$awards:\n$result";
}

sub tex {
  if ( $external::target eq "tex" ) {
    return $_[0];
  } else {
    return $_[1];
  }
}

sub var_in_tex {
  if ( $external::target eq "tex" ) {
    return $_[0];
  } else {
    return "";
  }
}

sub web {
  if ( $external::target eq "tex" ) {
    return $_[1];
  } else {
    if ( $external::target eq "web" || $external::target eq "answer") {
      return $_[2];
    } else {
      return $_[0];
    }
  }
}

sub html {
  if ( $external::target eq "web" ) {
    return shift;
  }
}

sub hinton {
  return 0;
}

sub random {
    my ($start,$end,$step)=@_;
    if ( ! $hidden::RANDOMINIT ) {
	if ($external::randomseed == 0) { $external::randomseed=1; }
	if ($external::randomseed =~/,/) {
	    my ($num1,$num2)=split(/,/,$seed);
	    &random_set_seed(abs($num1),abs($num2));
	} else {
	    &random_set_seed(1,int(abs($external::randomseed)));
	}
	&math_random_uniform();
	$hidden::RANDOMINIT=1;
    }
    if (!defined($step)) { $step=1; }
    my $num=1+int(($end-$start)/$step);
    my $result=$start + int(&math_random_uniform() * $num)*$step;
    return $result;
}

sub random_normal {
  my ($item_cnt,$seed,$av,$std_dev) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_normal($item_cnt,$av,$std_dev);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_beta {
  my ($item_cnt,$seed,$aa,$bb) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_beta($item_cnt,$aa,$bb);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_gamma {
  my ($item_cnt,$seed,$a,$r) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_gamma($item_cnt,$a,$r);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_exponential {
  my ($item_cnt,$seed,$av) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_exponential($item_cnt,$av);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_poisson {
  my ($item_cnt,$seed,$mu) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_poisson($item_cnt,$mu);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_chi {
  my ($item_cnt,$seed,$df) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_chi_square($item_cnt,$df);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_noncentral_chi {
  my ($item_cnt,$seed,$df,$nonc) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_f {
  my ($item_cnt,$seed,$dfn,$dfd) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_f($item_cnt,$dfn,$dfd);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_noncentral_f {
  my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_multivariate_normal {
  my ($item_cnt,$seed,$mean,$covar) = @_;
  my @oldseed=&random_get_seed();
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_multinomial {
  my ($item_cnt,$seed,@p) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_multinomial($item_cnt,@p);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_permutation {
  my ($seed,@inArray) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_permutation(@inArray);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_uniform {
  my ($item_cnt,$seed,$low,$high) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_uniform($item_cnt,$low,$high);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_uniform_integer {
  my ($item_cnt,$seed,$low,$high) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_uniform_integer($item_cnt,$low,$high);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_binomial {
  my ($item_cnt,$seed,$nt,$p) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_binomial($item_cnt,$nt,$p);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub random_negative_binomial {
  my ($item_cnt,$seed,$ne,$p) = @_;
  my @oldseed=&random_get_seed();
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_negative_binomial($item_cnt,$ne,$p);
  &random_set_seed(@oldseed);
  return @retArray;
}

sub abs { abs(shift) }
sub sin { sin(shift) }
sub cos { cos(shift) }
sub exp { exp(shift) }
sub int { int(shift) }
sub log { log(shift) }
sub atan2 { atan2($_[0],$_[1]) }
sub sqrt { sqrt(shift) }

sub tan  { CORE::sin($_[0]) / CORE::cos($_[0]) }
#sub atan { atan2($_[0], 1); }
#sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); }
#sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) );  }

sub log10 { CORE::log($_[0])/CORE::log(10); }

sub factorial {
    my $input = CORE::int(shift);
    return "Error - unable to take factorial of an negative number ($input)" if $input < 0;
    return "Error - factorial result is greater than system limit ($input)" if $input > 170;
    return 1 if $input == 0;
    my $result = 1; 
    for (my $i=2; $i<=$input; $i++) { $result *= $i }
    return $result;
}

sub sgn {
    return -1 if $_[0] < 0;
    return 0 if $_[0] == 0;
    return 1 if $_[0] > 0;
}

sub min {
    my @sorted = sort { $a <=> $b || $a cmp $b } @_;
    return shift @sorted;
}

sub max {
    my @sorted = sort { $a <=> $b || $a cmp $b } @_;
    return pop @sorted;
}

sub roundto {
    my ($input,$n) = @_;
    return sprintf('%.'.$n.'f',$input);
}

sub to_string {
    my ($input,$n) = @_;
    return sprintf($input) if $n eq "";
    $n = '.'.$n if $n !~ /^\./;
    return sprintf('%'.$n,$input) if $n ne "";
}

sub sub_string {
    my ($str,$start,$len) = @_;
    return substr($str,$start-1,$len);
}

sub pow   {return $_[0] ** $_[1]; }
sub ceil  {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? (CORE::int($_[0])+ 1) : CORE::int($_[0])); }
sub floor  {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? CORE::int($_[0]) : (CORE::int($_[0])-1)); }
#sub floor {return int($_[0]); }

sub format {
  my ($value,$fmt)=@_;
  my $dollarmode;
  if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } 
  my $result=sprintf('%.'.$fmt,$value);
  $result=~s/(E[+-]*)0/$1/;
  if ($dollarmode) {$result=&dollarmode($result);}
  return $result;
}

sub prettyprint {
  my ($value,$fmt)=@_;
  my $result;
  my $dollarmode;
  if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } 
  if ($fmt) { $value=sprintf('%.'.$fmt,$value); }
  if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/ ) {
    my $frac=$1;
    if ($dollarmode) { $frac=&dollarformat($frac); }
    my $exponent=$2;
    $exponent=~s/^\+0*//;
    $exponent=~s/^-0*/-/;
    if ($exponent) {
      if ($external::target eq 'web') {
	$result=$frac.'&#215;10<sup>'.$exponent.'</sup>';
      } elsif ($external::target eq 'tex') {
	$result='\ensuremath{'.$frac.'\times 10^{'.$exponent.'}}';
      } else {
	$result=$value;
      }
    } else {
      $result=$frac;
    }
  } else {
    $result=$value;
    if ($dollarmode) { $result=&dollarformat($result); }
  }
  return $result;
}

sub dollarformat {
  my ($number) = @_;
  if ($number =~ /\./) {
    while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*$)/) {
      $number = $1.','.$2.$3;
    }
  } else {
    while ($number =~ /([^,]+)([^,][^,][^,])([,0-9]*)$/) {
      $number = $1.','.$2.$3;
    }
  }
  if ($external::target eq 'tex') {
    $number='\$'.$number; #' stupid emacs
  } else {
    $number='$'.$number; #' stupid emacs
  }
  return $number; 
}

sub map {
    my ($phrase,$dest,$source)=@_;
    my @oldseed=&random_get_seed();
    my @seed = &random_seed_from_phrase($phrase);
    &random_set_seed(@seed);
    my $destct = scalar(@$dest);
    if (!$source) {
	my @output;
	my @idx = &math_random_permuted_index($destct);
	my $ctr = 0;
	while ($ctr < $destct) {
	    $output[$ctr] = $$dest[$idx[$ctr]];
	    $ctr++;
	}
        &random_set_seed(@oldseed);
	return @output;
    } else {
	my $num = scalar(@$source);
	my @idx = &math_random_permuted_index($num);
	my $ctr = 0;
	my $tot = $num;
	$tot = $destct if $destct < $num;
	if (ref($$dest[0])) {
	    while ($ctr < $tot) {
		${$$dest[$ctr]} = $$source[$idx[$ctr]];
	        $ctr++;
            }
        } else {
	    while ($ctr < $tot) {
		$$dest[$ctr] = $$source[$idx[$ctr]];
		$ctr++;
	    }
	}
    }
    &random_set_seed(@oldseed);
    return '';
}

sub rmap {
    my ($phrase,$dest,$source)=@_;
    my @oldseed=&random_get_seed();
    my @seed = &random_seed_from_phrase($phrase);
    &random_set_seed(@seed);
    my $destct = scalar(@$dest);
    if (!$source) {
	my @idx = &math_random_permuted_index($destct);
	my $ctr = 0;
	my @r_idx;
	while ($ctr < $destct) {
	    $r_idx[$idx[$ctr]] = $ctr;
	    $ctr++;
	}
	my @output;
	$ctr = 0;
	while ($ctr < $destct) {
	    $output[$ctr] = $$dest[$r_idx[$ctr]];
	    $ctr++;
	}
        &random_set_seed(@oldseed);
	return @output;
    } else {
	my $num = scalar(@$source);
	my @idx = &math_random_permuted_index($num);
	my $ctr = 0;
	my $tot = $num;
	$tot = $destct if $destct < $num;
	my @r_idx;
	while ($ctr < $tot) {
	    $r_idx[$idx[$ctr]] = $ctr;
	    $ctr++;
	}
	$ctr = 0;
	if (ref($$dest[0])) {
	    while ($ctr < $tot) {
		${$$dest[$ctr]} = $$source[$r_idx[$ctr]];
	        $ctr++;
            }
        } else {
	    while ($ctr < $tot) {
		$$dest[$ctr] = $$source[$r_idx[$ctr]];
		$ctr++;
	    }
	}
    }
    &random_set_seed(@oldseed);
    return '';
}

sub capa_id { return }

sub problem { return }

sub name{
  my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename');
  $fullname = "" if $fullname eq ",  ";
  $fullname =~ s/\%2d/-/g;
  return $fullname;
}

sub student_number { 
  my $id = &EXT('environment.id');
  $id = '' if $id eq "";
  return $id;
}

sub class {
  my $course = &EXT('course.description');
  $course = '' if $course eq "";
  return $course;
}

sub sec { 
  my $sec = &EXT('request.course.sec');
  $sec = '' if $sec eq "";
  return $sec;
}

sub open_date { 
  my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate')));
  return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
  my @hm = split(/:/,$dc[3]);
  my $ampm = " am";
  if ($hm[0] > 12) {
    $hm[0]-=12;
    $ampm = " pm";
  }
  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
}

sub due_date { 
  my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate')));
  return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
  my @hm = split(/:/,$dc[3]);
  my $ampm = " am";
  if ($hm[0] > 12) {
    $hm[0]-=12;
    $ampm = " pm";
  }
  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
#  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
}

sub answer_date { 
  my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate')));
  return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
  my @hm = split(/:/,$dc[3]);
  my $ampm = " am";
  if ($hm[0] > 12) {
    $hm[0]-=12;
    $ampm = " pm";
  }
  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
#  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
}

sub array_moments {
  my @input=@_;
  my (@output,$N);
  $N=scalar (@input);
  $output[0]=$N;
  if ($N <= 1) {
    $output[1]=$input[0];
    $output[1]="Input array not defined" if ($N == 0);
    $output[2]="variance undefined for N<=1";
    $output[3]="skewness undefined for N<=1";
    $output[4]="kurtosis undefined for N<=1";
    return @output;
  }
  my $sum=0;
  foreach my $line (@input) {
    $sum+=$line;
  }
  $output[1] = $sum/$N;
  my ($x,$sdev,$var,$skew,$kurt) = 0;
  foreach my $line (@input) {
    $x=$line-$output[1];
    $var+=$x**2;
    $skew+=$x**3;
    $kurt+=$x**4;
  }
  $output[2]=$var/($N-1);
  $sdev=CORE::sqrt($output[2]);
  if ($sdev == 0) {
     $output[3]="inf-variance=0";
     $output[4]="inf-variance=0";
     return @output;
  }
  $output[3]=$skew/($sdev**3*$N);
  $output[4]=$kurt/($sdev**4*$N)-3;
  return @output;
}

sub choose {
  my $num = $_[0];
  return $_[$num];
}

# expiremental idea
sub proper_path {
  my ($path)=@_;
  if ( $external::target eq "tex" ) {
    return '/home/httpd/html'.$path;
  } else {
    return $path;
  }
}


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