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

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

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