Annotation of loncom/homework/default_homework.lcpm, revision 1.33

1.25      albertel    1: # file name (temp): default_homework
1.1       harris41    2: # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
1.20      harris41    3: #
                      4: # Guy Albertelli
                      5: #
                      6: # 05/25/2001 H. K. Ng
1.24      ng          7: # 05/31/2001 H. K. Ng
1.20      harris41    8: #
1.25      albertel    9: #init some globals
1.3       albertel   10: $RANDOMINIT=0;
1.22      ng         11: $pi=atan2(1,1)*4;
                     12: $rad2deg=180.0/$pi;
                     13: $deg2rad=$pi/180.0;
1.3       albertel   14: 
1.7       albertel   15: sub caparesponse_check {
1.10      albertel   16:   my $answer='';  #done
                     17:   my $type='';    #done
                     18:   my $tol_type=''; # gets it's value from whether tol has a % or not done
                     19:   my $tol='';     #done
1.19      albertel   20:   my $sig='';     #done lowerbnd,upperbnd
                     21:   my $sig_lbound=''; #done
                     22:   my $sig_ubound=''; #done
1.7       albertel   23:   my $ans_fmt='';
1.29      albertel   24:   my $unit='';     #done
1.7       albertel   25:   my $calc='';
                     26:   my ($response,$expr)=@_;
1.31      albertel   27: 
1.32      albertel   28: 
1.12      albertel   29:   ($answer,$type,$tol,$sig,$ans_fmt,
1.31      albertel   30:    $unit,$calc) = eval $expr.';return ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc);';
1.8       albertel   31:   #type's definitons come from capaParser.h
1.31      albertel   32:   my $message='';
1.32      albertel   33:   #remove leading and trailing whitespace
                     34:   if ($response=~ /^\s|\s$/) {
                     35:     $response=~ s:^\s+|\s+$::g;
                     36:     $message .="Removed ws now :$response:<br />";
                     37:   } else {
                     38:     $message .="no ws in :$response:<br />";
                     39:   }
                     40: 
1.8       albertel   41:   if ($type eq '' ) {
1.31      albertel   42:     $message .= "Didn't find a type :$type:$expr: defaulting<br />";
1.8       albertel   43:     if ( $answer eq ($answer *1.0)) { $type = 2;
                     44:     } else { $type = 3; }
                     45:   } else {
                     46:          if ($type eq 'cs')    { $type = 4;
                     47:     } elsif ($type eq 'ci')    { $type = 3;
                     48:     } elsif ($type eq 'mc')    { $type = 5;
                     49:     } elsif ($type eq 'fml')   { $type = 8;
1.9       albertel   50:     } elsif ($type eq 'subj')  { $type = 7;
                     51:     } else { return "ERROR: Unknown type of answer: $type" }
1.8       albertel   52:   }
                     53: 
1.10      albertel   54:   if ($tol eq '') {
                     55:     $tol=0.0;
                     56:     $tol_type=1; #TOL_ABSOLUTE
                     57:   } else {
                     58:     if ($tol =~ /%$/) {
1.12      albertel   59:       chop $tol;
1.10      albertel   60:       $tol_type=2; #TOL_PERCENTAGE
                     61:     } else {
                     62:       $tol_type=1; #TOL_ABSOLUTE
                     63:     }
                     64:   }
1.12      albertel   65: 
                     66:   if ($sig eq '') {
                     67:     $sig_lbound = 0; #SIG_LB_DEFAULT
                     68:     $sig_ubound =15; #SIG_UB_DEFAULT
                     69:   } else {
                     70:     ($sig_lbound,$sig_ubound) = split /,/,$sig;
                     71:   }
1.7       albertel   72:   my $result = &caparesponse_capa_check_answer($response,$answer,$type,
1.10      albertel   73: 					       $tol_type,$tol,
1.7       albertel   74: 					       $sig_lbound,$sig_ubound,
1.29      albertel   75: 					       $ans_fmt,$unit,$calc);
1.9       albertel   76: 
                     77:   if    ($result == '1') { $result='EXACT_ANS'; } 
                     78:   elsif ($result == '2') { $result='APPROX_ANS'; }
                     79:   elsif ($result == '3') { $result='SIG_FAIL'; }
                     80:   elsif ($result == '4') { $result='UNIT_FAIL'; }
                     81:   elsif ($result == '5') { $result='NO_UNIT'; }
                     82:   elsif ($result == '6') { $result='UNIT_OK'; }
                     83:   elsif ($result == '7') { $result='INCORRECT'; }
                     84:   elsif ($result == '8') { $result='UNIT_NOTNEEDED'; }
                     85:   elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; }
                     86:   elsif ($result =='10') { $result='SUB_RECORDED'; }
                     87:   elsif ($result =='11') { $result='BAD_FORMULA'; }
                     88:   elsif ($result =='12') { $result='WANTED_NUMERIC'; }
1.13      albertel   89:   else  {$result = "ERROR: Unknown Result:$result:$@:";}
1.9       albertel   90: 
1.31      albertel   91:   return "$result:<br />Error $error:<br />Answer $answer:<br />Response $response:<br /> type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$units<br />$message$expr";
1.14      albertel   92: }
                     93: 
                     94: sub caparesponse_check_list {
                     95:   my ($response,$expr)=@_;
1.30      albertel   96:   # do these first, because who knows what varname the instructor might have used
                     97:   # but it probably isn't $CAPARESPONSE_CHECK_LIST_answer
                     98:   my $CAPARESPONSE_CHECK_LIST_answer = eval $expr.';return $answer';
                     99:   my (@list) = eval $CAPARESPONSE_CHECK_LIST_answer;
1.14      albertel  100:   my $result='';
1.31      albertel  101:   $result.="error:$@:<br />";
                    102:   # if the eval fails just use what is in the answer exactly
                    103:   if (!defined(@list) || !defined($list[0])) {
                    104:     $result.="list zero is undefined<br />";
                    105:     $list[0]=$CAPARESPONSE_CHECK_LIST_answer;
                    106:   }
1.15      albertel  107:   my $aresult='';
1.14      albertel  108:   my $current_answer;
1.31      albertel  109:   $result.="Got response :$CAPARESPONSE_CHECK_LIST_answer:$list[0]:<br />";
                    110:   my @responselist;
1.32      albertel  111:   my $type =eval $expr.';return $answer;';
1.31      albertel  112:   if ($type ne '' && $#list > 0) {
                    113:     (@responselist)=split /,/,$response;
                    114:   } else {
                    115:     (@responselist)=($response);
                    116:   }
1.15      albertel  117:   my $unit='';
1.31      albertel  118:   $result.="Initial final response :$responselist['-1']:<br />";
                    119:   if ($type eq '') {
                    120:     #for numerical problems split off the unit
                    121:     if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) {
                    122:       $responselist['-1']=$1;
                    123:       $unit=$2;
                    124:     }
1.15      albertel  125:   }
1.31      albertel  126:   $result.="Final final response :$responselist['-1']:<br />";
                    127:   $result.=":$#list: answers<br />";
1.14      albertel  128:   $unit=~s/\s//;
                    129:   my $i=0;
                    130:   my $awards='';
                    131:   for ($i=0; $i<@list;$i++) {
1.31      albertel  132:     $result.="trying answer :$list[$i]:<br />";
1.19      albertel  133:     if ($unit eq '') {
                    134:       $aresult=&caparesponse_check($responselist[$i],
1.31      albertel  135: 			     $expr.';my $answer=\''.$list[$i].'\';');
1.19      albertel  136:     } else {
                    137:       $aresult=&caparesponse_check($responselist[$i]." $unit",
1.31      albertel  138: 				   $expr.';my $answer=\''.$list[$i].'\';');
1.19      albertel  139:     }
1.15      albertel  140:     my ($temp)=split /:/, $aresult;
1.14      albertel  141:     $awards.="$temp,";
1.15      albertel  142:     $result.=$aresult;
1.14      albertel  143:   }
                    144:   chop $awards;
1.17      albertel  145:   return "$awards:<br />$result";
1.7       albertel  146: }
                    147: 
1.4       albertel  148: sub tex {
                    149:   if ( $external::target eq "tex" ) {
                    150:     return @_[0];
                    151:   } else {
                    152:     return @_[1];
                    153:   }
                    154: }
                    155: 
1.24      ng        156: sub var_in_tex {
                    157:   if ( $external::target eq "tex" ) {
                    158:     return @_[0];
                    159:   } else {
                    160:     return "";
                    161:   }
                    162: }
                    163: 
1.4       albertel  164: sub web {
                    165:   if ( $external::target eq "tex" ) {
                    166:     return @_[1];
                    167:   } else {
                    168:     if ( $external::target eq "web") {
1.26      ng        169:       return @_[2];
                    170:     } else {
1.4       albertel  171:       return @_[0];
                    172:     }
                    173:   }
                    174: }
                    175: 
1.24      ng        176: sub html {
                    177:   if ( $external::target eq "web" ) {
1.26      ng        178:     return shift;
1.24      ng        179:   }
                    180: }
                    181: 
1.4       albertel  182: sub problem {
1.11      albertel  183:   return '1';
1.4       albertel  184: }
                    185: 
1.1       harris41  186: sub hinton {
                    187:   return 0;
                    188: }
                    189: 
                    190: sub random {
                    191:   my ($start,$end,$step)=@_;
1.3       albertel  192:   if ( ! $RANDOMINIT ) { srand($external::randomseed); $RANDOMINIT=1; }
1.1       harris41  193:   my $num=1+int(($end-$start)/$step);
                    194:   my $result=$start + int(rand() * $num)*$step;
                    195:   return $result;
                    196: }
                    197: 
1.26      ng        198: sub random_normal {
                    199:   my ($item_cnt,$seed,$av,$std_dev) = @_;
                    200:   my @retArray;
                    201:   &random_set_seed_from_phrase($seed);
                    202:   @retArray=&math_random_normal($item_cnt,$av,$std_dev);
                    203:   return @retArray;
                    204: }
                    205: 
                    206: sub random_beta {
                    207:   my ($item_cnt,$seed,$aa,$bb) = @_;
                    208:   my @retArray;
                    209:   &random_set_seed_from_phrase($seed);
                    210:   @retArray=&math_random_beta($item_cnt,$aa,$bb);
                    211:   return @retArray;
                    212: }
                    213: 
                    214: sub random_gamma {
                    215:   my ($item_cnt,$seed,$a,$r) = @_;
                    216:   my @retArray;
                    217:   &random_set_seed_from_phrase($seed);
                    218:   @retArray=&math_random_gamma($item_cnt,$a,$r);
                    219:   return @retArray;
                    220: }
                    221: 
                    222: sub random_exponential {
                    223:   my ($item_cnt,$seed,$av) = @_;
                    224:   my @retArray;
                    225:   &random_set_seed_from_phrase($seed);
                    226:   @retArray=&math_random_exponential($item_cnt,$av);
                    227:   return @retArray;
                    228: }
                    229: 
                    230: sub random_poisson {
                    231:   my ($item_cnt,$seed,$mu) = @_;
                    232:   my @retArray;
                    233:   &random_set_seed_from_phrase($seed);
                    234:   @retArray=&math_random_poisson($item_cnt,$mu);
                    235:   return @retArray;
                    236: }
                    237: 
                    238: sub random_chi {
                    239:   my ($item_cnt,$seed,$df) = @_;
                    240:   my @retArray;
                    241:   &random_set_seed_from_phrase($seed);
                    242:   @retArray=&math_random_chi_square($item_cnt,$df);
                    243:   return @retArray;
                    244: }
                    245: 
                    246: sub random_noncentral_chi {
                    247:   my ($item_cnt,$seed,$df,$nonc) = @_;
                    248:   my @retArray;
                    249:   &random_set_seed_from_phrase($seed);
                    250:   @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc);
                    251:   return @retArray;
                    252: }
                    253: 
                    254: sub random_f {
                    255:   my ($item_cnt,$seed,$dfn,$dfd) = @_;
                    256:   my @retArray;
                    257:   &random_set_seed_from_phrase($seed);
                    258:   @retArray=&math_random_f($item_cnt,$dfn,$dfd);
                    259:   return @retArray;
                    260: }
                    261: 
                    262: sub random_noncentral_f {
                    263:   my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_;
                    264:   my @retArray;
                    265:   &random_set_seed_from_phrase($seed);
                    266:   @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc);
                    267:   return @retArray;
                    268: }
                    269: 
                    270: sub random_multivariate_normal {
1.33    ! ng        271:   my ($item_cnt,$seed,$mean,$covar) = @_;
1.26      ng        272:   &random_set_seed_from_phrase($seed);
1.33    ! ng        273:   @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar);
1.26      ng        274:   return @retArray;
                    275: }
                    276: 
                    277: sub random_multinomial {
                    278:   my ($item_cnt,$seed,@p) = @_;
                    279:   my @retArray;
                    280:   &random_set_seed_from_phrase($seed);
                    281:   @retArray=&math_random_multinomial($item_cnt,@p);
                    282:   return @retArray;
                    283: }
                    284: 
                    285: sub random_permutation {
                    286:   my ($seed,@inArray) = @_;
                    287:   my @retArray;
                    288:   &random_set_seed_from_phrase($seed);
                    289:   @retArray=&math_random_permutation(@inArray);
                    290:   return @retArray;
                    291: }
                    292: 
                    293: sub random_uniform {
                    294:   my ($item_cnt,$seed,$low,$high) = @_;
                    295:   my @retArray;
                    296:   &random_set_seed_from_phrase($seed);
                    297:   @retArray=&math_random_uniform($item_cnt,$low,$high);
                    298:   return @retArray;
                    299: }
                    300: 
                    301: sub random_uniform_integer {
                    302:   my ($item_cnt,$seed,$low,$high) = @_;
                    303:   my @retArray;
                    304:   &random_set_seed_from_phrase($seed);
                    305:   @retArray=&math_random_uniform_integer($item_cnt,$low,$high);
                    306:   return @retArray;
                    307: }
                    308: 
                    309: sub random_binomial {
                    310:   my ($item_cnt,$seed,$nt,$p) = @_;
                    311:   my @retArray;
                    312:   &random_set_seed_from_phrase($seed);
                    313:   @retArray=&math_random_binomial($item_cnt,$nt,$p);
                    314:   return @retArray;
                    315: }
                    316: 
                    317: sub random_negative_binomial {
                    318:   my ($item_cnt,$seed,$ne,$p) = @_;
                    319:   my @retArray;
                    320:   &random_set_seed_from_phrase($seed);
                    321:   @retArray=&math_random_negative_binomial($item_cnt,$ne,$p);
                    322:   return @retArray;
                    323: }
                    324: 
1.23      ng        325: sub abs { abs(shift) }
                    326: sub sin { sin(shift) }
                    327: sub cos { cos(shift) }
                    328: sub exp { exp(shift) }
                    329: sub int { int(shift) }
                    330: sub log { log(shift) }
                    331: sub atan2 { atan2($_[0],$_[1]) }
                    332: sub sqrt { sqrt(shift) }
                    333: 
1.1       harris41  334: sub tan  { sin($_[0]) / cos($_[0]) }
1.21      harris41  335: #sub atan { atan2($_[0], 1); }
                    336: #sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); }
                    337: #sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) );  }
1.22      ng        338: 
1.18      albertel  339: sub log10 { log($_[0])/log(10); }
1.22      ng        340: 
1.20      harris41  341: sub factorial {
                    342:     my $input = int(shift);
                    343:     return "Error - unable to take factorial of an negative number ($input)" if $input < 0;
                    344:     return "Error - factorial result is greater than system limit ($input)" if $input > 170;
                    345:     return 1 if $input == 0;
                    346:     my $result = 1; 
                    347:     for (my $i=2; $i<=$input; $i++) { $result *= $i }
                    348:     return $result;
                    349: }
                    350: 
                    351: sub sgn {
                    352:     return -1 if $_[0] < 0;
                    353:     return 0 if $_[0] == 0;
                    354:     return 1 if $_[0] > 0;
                    355: }
                    356: 
                    357: sub min {
                    358:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
                    359:     return shift @sorted;
                    360: }
                    361: 
                    362: sub max {
                    363:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
                    364:     return pop @sorted;
                    365: }
1.1       harris41  366: 
1.20      harris41  367: sub roundto {
                    368:     my ($input,$n) = @_;
                    369:     return sprintf('%.'.$n.'f',$input);
                    370: }
                    371: 
                    372: sub to_string {
                    373:     my ($input,$n) = @_;
1.26      ng        374:     return sprintf($input) if $n eq "";
                    375:     $n = '.'.$n if $n !~ /^\./;
1.20      harris41  376:     return sprintf('%'.$n,$input) if $n ne "";
                    377: }
                    378: 
                    379: sub sub_string {
                    380:     my ($str,$start,$len) = @_;
                    381:     return substr($str,$start-1,$len);
                    382: }
1.1       harris41  383: 
                    384: sub pow   {return $_[0] ** $_[1]; }
1.27      ng        385: sub ceil  {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? (int($_[0])+ 1) : int($_[0])); }
                    386: sub floor  {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? int($_[0]) : (int($_[0])-1)); }
                    387: #sub floor {return int($_[0]); }
1.1       harris41  388: 
1.2       albertel  389: sub format {
                    390:   my ($value,$fmt)=@_;
1.11      albertel  391:   return sprintf('%.'.$fmt,$value);
1.2       albertel  392: }
1.5       albertel  393: 
                    394: sub map {
1.27      ng        395:     my ($phrase,$dest,$source)=@_;
                    396:     my @seed = &random_seed_from_phrase($phrase);
                    397:     &random_set_seed(@seed);
                    398:     my $destct = scalar(@$dest);
1.28      ng        399:     if (!$source) {
                    400: 	my @output;
                    401: 	my @idx = &math_random_permuted_index($destct);
                    402: 	my $ctr = 0;
                    403: 	while ($ctr < $destct) {
                    404: 	    $output[$ctr] = $$dest[$idx[$ctr]];
1.27      ng        405: 	    $ctr++;
1.28      ng        406: 	}
                    407: 	return @output;
1.27      ng        408:     } else {
1.28      ng        409: 	my $num = scalar(@$source);
                    410: 	my @idx = &math_random_permuted_index($num);
                    411: 	my $ctr = 0;
                    412: 	my $tot = $num;
                    413: 	$tot = $destct if $destct < $num;
                    414: 	if (ref($$dest[0])) {
                    415: 	    while ($ctr < $tot) {
                    416: 		${$$dest[$ctr]} = $$source[$idx[$ctr]];
                    417: 	        $ctr++;
                    418:             }
                    419:         } else {
                    420: 	    while ($ctr < $tot) {
                    421: 		$$dest[$ctr] = $$source[$idx[$ctr]];
                    422: 		$ctr++;
                    423: 	    }
                    424: 	}
1.27      ng        425:     }
                    426: }
                    427: 
                    428: sub rmap {
                    429:     my ($phrase,$dest,$source)=@_;
                    430:     my @seed = &random_seed_from_phrase($phrase);
                    431:     &random_set_seed(@seed);
                    432:     my $destct = scalar(@$dest);
1.28      ng        433:     if (!$source) {
                    434: 	my @idx = &math_random_permuted_index($destct);
                    435: 	my $ctr = 0;
                    436: 	my @r_idx;
                    437: 	while ($ctr < $destct) {
                    438: 	    $r_idx[$idx[$ctr]] = $ctr;
                    439: 	    $ctr++;
                    440: 	}
                    441: 	my @output;
                    442: 	$ctr = 0;
                    443: 	while ($ctr < $destct) {
                    444: 	    $output[$ctr] = $$dest[$r_idx[$ctr]];
1.27      ng        445: 	    $ctr++;
1.28      ng        446: 	}
                    447: 	return @output;
1.27      ng        448:     } else {
1.28      ng        449: 	my $num = scalar(@$source);
                    450: 	my @idx = &math_random_permuted_index($num);
                    451: 	my $ctr = 0;
                    452: 	my $tot = $num;
                    453: 	$tot = $destct if $destct < $num;
                    454: 	my @r_idx;
1.27      ng        455: 	while ($ctr < $tot) {
1.28      ng        456: 	    $r_idx[$idx[$ctr]] = $ctr;
1.27      ng        457: 	    $ctr++;
1.28      ng        458: 	}
                    459: 	$ctr = 0;
                    460: 	if (ref($$dest[0])) {
                    461: 	    while ($ctr < $tot) {
                    462: 		${$$dest[$ctr]} = $$source[$r_idx[$ctr]];
                    463: 	        $ctr++;
                    464:             }
                    465:         } else {
                    466: 	    while ($ctr < $tot) {
                    467: 		$$dest[$ctr] = $$source[$r_idx[$ctr]];
                    468: 		$ctr++;
                    469: 	    }
                    470: 	}
1.6       albertel  471:     }
1.5       albertel  472: }
1.22      ng        473: 
1.23      ng        474: sub capa_id { return }
                    475: 
                    476: sub problem { return }
                    477: 
1.22      ng        478: sub name{
                    479:   my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename');
                    480:   $fullname = "" if $fullname eq ",  ";
1.26      ng        481:   $fullname =~ s/\%2d/-/g;
1.22      ng        482:   return $fullname;
                    483: }
                    484: 
                    485: sub student_number { 
                    486:   my $id = &EXT('environment.id');
                    487:   $id = '' if $id eq "";
                    488:   return $id;
                    489: }
                    490: 
                    491: sub class {
                    492:   my $course = &EXT('course.description');
                    493:   $course = '' if $course eq "";
                    494:   return $course;
                    495: }
                    496: 
                    497: sub sec { 
                    498:   my $sec = &EXT('request.course.sec');
1.23      ng        499:   $sec = '' if $sec eq "";
1.22      ng        500:   return $sec;
                    501: }
                    502: 
1.23      ng        503: sub open_date { 
                    504:   my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate')));
1.24      ng        505:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    506:   my @hm = split(/:/,$dc[3]);
                    507:   my $ampm = " am";
                    508:   if ($hm[0] > 12) {
                    509:     $hm[0]-=12;
                    510:     $ampm = " pm";
                    511:   }
                    512:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
1.23      ng        513: }
                    514: 
                    515: sub due_date { 
                    516:   my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate')));
1.24      ng        517:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    518:   my @hm = split(/:/,$dc[3]);
                    519:   my $ampm = " am";
                    520:   if ($hm[0] > 12) {
                    521:     $hm[0]-=12;
                    522:     $ampm = " pm";
                    523:   }
                    524:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
                    525: #  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
1.23      ng        526: }
                    527: 
                    528: sub answer_date { 
                    529:   my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate')));
1.24      ng        530:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    531:   my @hm = split(/:/,$dc[3]);
                    532:   my $ampm = " am";
                    533:   if ($hm[0] > 12) {
                    534:     $hm[0]-=12;
                    535:     $ampm = " pm";
                    536:   }
                    537:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
                    538: #  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
                    539: }
                    540: 
                    541: sub array_moments {
                    542:   my @input=@_;
                    543:   my (@output,$N);
                    544:   $N=scalar (@input);
                    545:   $output[0]=$N;
                    546:   if ($N <= 1) {
                    547:     $output[1]=$input[0];
1.28      ng        548:     $output[1]="Input array not defined" if ($N == 0);
1.24      ng        549:     $output[2]="variance undefined for N<=1";
                    550:     $output[3]="skewness undefined for N<=1";
                    551:     $output[4]="kurtosis undefined for N<=1";
                    552:     return @output;
                    553:   }
                    554:   my $sum=0;
                    555:   foreach my $line (@input) {
                    556:     $sum+=$line;
                    557:   }
                    558:   $output[1] = $sum/$N;
                    559:   my ($x,$sdev,$var,$skew,$kurt) = 0;
                    560:   foreach my $line (@input) {
                    561:     $x=$line-$output[1];
                    562:     $var+=$x**2;
                    563:     $skew+=$x**3;
                    564:     $kurt+=$x**4;
                    565:   }
                    566:   $output[2]=$var/($N-1);
                    567:   $sdev=sqrt($output[2]);
                    568:   if ($sdev == 0) {
                    569:      $output[3]="inf-variance=0";
                    570:      $output[4]="inf-variance=0";
                    571:      return @output;
                    572:   }
                    573:   $output[3]=$skew/($sdev**3*$N);
                    574:   $output[4]=$kurt/($sdev**4*$N)-3;
                    575:   return @output;
                    576: }
1.5       albertel  577: 
                    578: sub choose {
                    579:   my $num = $_[0];
                    580:   return $_[$num];
                    581: }
1.23      ng        582: 
                    583: 

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