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

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.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.3       albertel  194:   if ( ! $RANDOMINIT ) { srand($external::randomseed); $RANDOMINIT=1; }
1.1       harris41  195:   my $num=1+int(($end-$start)/$step);
                    196:   my $result=$start + int(rand() * $num)*$step;
                    197:   return $result;
                    198: }
                    199: 
1.26      ng        200: sub random_normal {
                    201:   my ($item_cnt,$seed,$av,$std_dev) = @_;
                    202:   my @retArray;
                    203:   &random_set_seed_from_phrase($seed);
                    204:   @retArray=&math_random_normal($item_cnt,$av,$std_dev);
                    205:   return @retArray;
                    206: }
                    207: 
                    208: sub random_beta {
                    209:   my ($item_cnt,$seed,$aa,$bb) = @_;
                    210:   my @retArray;
                    211:   &random_set_seed_from_phrase($seed);
                    212:   @retArray=&math_random_beta($item_cnt,$aa,$bb);
                    213:   return @retArray;
                    214: }
                    215: 
                    216: sub random_gamma {
                    217:   my ($item_cnt,$seed,$a,$r) = @_;
                    218:   my @retArray;
                    219:   &random_set_seed_from_phrase($seed);
                    220:   @retArray=&math_random_gamma($item_cnt,$a,$r);
                    221:   return @retArray;
                    222: }
                    223: 
                    224: sub random_exponential {
                    225:   my ($item_cnt,$seed,$av) = @_;
                    226:   my @retArray;
                    227:   &random_set_seed_from_phrase($seed);
                    228:   @retArray=&math_random_exponential($item_cnt,$av);
                    229:   return @retArray;
                    230: }
                    231: 
                    232: sub random_poisson {
                    233:   my ($item_cnt,$seed,$mu) = @_;
                    234:   my @retArray;
                    235:   &random_set_seed_from_phrase($seed);
                    236:   @retArray=&math_random_poisson($item_cnt,$mu);
                    237:   return @retArray;
                    238: }
                    239: 
                    240: sub random_chi {
                    241:   my ($item_cnt,$seed,$df) = @_;
                    242:   my @retArray;
                    243:   &random_set_seed_from_phrase($seed);
                    244:   @retArray=&math_random_chi_square($item_cnt,$df);
                    245:   return @retArray;
                    246: }
                    247: 
                    248: sub random_noncentral_chi {
                    249:   my ($item_cnt,$seed,$df,$nonc) = @_;
                    250:   my @retArray;
                    251:   &random_set_seed_from_phrase($seed);
                    252:   @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc);
                    253:   return @retArray;
                    254: }
                    255: 
                    256: sub random_f {
                    257:   my ($item_cnt,$seed,$dfn,$dfd) = @_;
                    258:   my @retArray;
                    259:   &random_set_seed_from_phrase($seed);
                    260:   @retArray=&math_random_f($item_cnt,$dfn,$dfd);
                    261:   return @retArray;
                    262: }
                    263: 
                    264: sub random_noncentral_f {
                    265:   my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_;
                    266:   my @retArray;
                    267:   &random_set_seed_from_phrase($seed);
                    268:   @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc);
                    269:   return @retArray;
                    270: }
                    271: 
                    272: sub random_multivariate_normal {
1.33      ng        273:   my ($item_cnt,$seed,$mean,$covar) = @_;
1.26      ng        274:   &random_set_seed_from_phrase($seed);
1.33      ng        275:   @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar);
1.26      ng        276:   return @retArray;
                    277: }
                    278: 
                    279: sub random_multinomial {
                    280:   my ($item_cnt,$seed,@p) = @_;
                    281:   my @retArray;
                    282:   &random_set_seed_from_phrase($seed);
                    283:   @retArray=&math_random_multinomial($item_cnt,@p);
                    284:   return @retArray;
                    285: }
                    286: 
                    287: sub random_permutation {
                    288:   my ($seed,@inArray) = @_;
                    289:   my @retArray;
                    290:   &random_set_seed_from_phrase($seed);
                    291:   @retArray=&math_random_permutation(@inArray);
                    292:   return @retArray;
                    293: }
                    294: 
                    295: sub random_uniform {
                    296:   my ($item_cnt,$seed,$low,$high) = @_;
                    297:   my @retArray;
                    298:   &random_set_seed_from_phrase($seed);
                    299:   @retArray=&math_random_uniform($item_cnt,$low,$high);
                    300:   return @retArray;
                    301: }
                    302: 
                    303: sub random_uniform_integer {
                    304:   my ($item_cnt,$seed,$low,$high) = @_;
                    305:   my @retArray;
                    306:   &random_set_seed_from_phrase($seed);
                    307:   @retArray=&math_random_uniform_integer($item_cnt,$low,$high);
                    308:   return @retArray;
                    309: }
                    310: 
                    311: sub random_binomial {
                    312:   my ($item_cnt,$seed,$nt,$p) = @_;
                    313:   my @retArray;
                    314:   &random_set_seed_from_phrase($seed);
                    315:   @retArray=&math_random_binomial($item_cnt,$nt,$p);
                    316:   return @retArray;
                    317: }
                    318: 
                    319: sub random_negative_binomial {
                    320:   my ($item_cnt,$seed,$ne,$p) = @_;
                    321:   my @retArray;
                    322:   &random_set_seed_from_phrase($seed);
                    323:   @retArray=&math_random_negative_binomial($item_cnt,$ne,$p);
                    324:   return @retArray;
                    325: }
                    326: 
1.23      ng        327: sub abs { abs(shift) }
                    328: sub sin { sin(shift) }
                    329: sub cos { cos(shift) }
                    330: sub exp { exp(shift) }
                    331: sub int { int(shift) }
                    332: sub log { log(shift) }
                    333: sub atan2 { atan2($_[0],$_[1]) }
                    334: sub sqrt { sqrt(shift) }
                    335: 
1.1       harris41  336: sub tan  { sin($_[0]) / cos($_[0]) }
1.21      harris41  337: #sub atan { atan2($_[0], 1); }
                    338: #sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); }
                    339: #sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) );  }
1.22      ng        340: 
1.18      albertel  341: sub log10 { log($_[0])/log(10); }
1.22      ng        342: 
1.20      harris41  343: sub factorial {
                    344:     my $input = int(shift);
                    345:     return "Error - unable to take factorial of an negative number ($input)" if $input < 0;
                    346:     return "Error - factorial result is greater than system limit ($input)" if $input > 170;
                    347:     return 1 if $input == 0;
                    348:     my $result = 1; 
                    349:     for (my $i=2; $i<=$input; $i++) { $result *= $i }
                    350:     return $result;
                    351: }
                    352: 
                    353: sub sgn {
                    354:     return -1 if $_[0] < 0;
                    355:     return 0 if $_[0] == 0;
                    356:     return 1 if $_[0] > 0;
                    357: }
                    358: 
                    359: sub min {
                    360:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
                    361:     return shift @sorted;
                    362: }
                    363: 
                    364: sub max {
                    365:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
                    366:     return pop @sorted;
                    367: }
1.1       harris41  368: 
1.20      harris41  369: sub roundto {
                    370:     my ($input,$n) = @_;
                    371:     return sprintf('%.'.$n.'f',$input);
                    372: }
                    373: 
                    374: sub to_string {
                    375:     my ($input,$n) = @_;
1.26      ng        376:     return sprintf($input) if $n eq "";
                    377:     $n = '.'.$n if $n !~ /^\./;
1.20      harris41  378:     return sprintf('%'.$n,$input) if $n ne "";
                    379: }
                    380: 
                    381: sub sub_string {
                    382:     my ($str,$start,$len) = @_;
                    383:     return substr($str,$start-1,$len);
                    384: }
1.1       harris41  385: 
                    386: sub pow   {return $_[0] ** $_[1]; }
1.27      ng        387: sub ceil  {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? (int($_[0])+ 1) : int($_[0])); }
                    388: sub floor  {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? int($_[0]) : (int($_[0])-1)); }
                    389: #sub floor {return int($_[0]); }
1.1       harris41  390: 
1.2       albertel  391: sub format {
                    392:   my ($value,$fmt)=@_;
1.11      albertel  393:   return sprintf('%.'.$fmt,$value);
1.2       albertel  394: }
1.5       albertel  395: 
                    396: sub map {
1.27      ng        397:     my ($phrase,$dest,$source)=@_;
                    398:     my @seed = &random_seed_from_phrase($phrase);
                    399:     &random_set_seed(@seed);
                    400:     my $destct = scalar(@$dest);
1.28      ng        401:     if (!$source) {
                    402: 	my @output;
                    403: 	my @idx = &math_random_permuted_index($destct);
                    404: 	my $ctr = 0;
                    405: 	while ($ctr < $destct) {
                    406: 	    $output[$ctr] = $$dest[$idx[$ctr]];
1.27      ng        407: 	    $ctr++;
1.28      ng        408: 	}
                    409: 	return @output;
1.27      ng        410:     } else {
1.28      ng        411: 	my $num = scalar(@$source);
                    412: 	my @idx = &math_random_permuted_index($num);
                    413: 	my $ctr = 0;
                    414: 	my $tot = $num;
                    415: 	$tot = $destct if $destct < $num;
                    416: 	if (ref($$dest[0])) {
                    417: 	    while ($ctr < $tot) {
                    418: 		${$$dest[$ctr]} = $$source[$idx[$ctr]];
                    419: 	        $ctr++;
                    420:             }
                    421:         } else {
                    422: 	    while ($ctr < $tot) {
                    423: 		$$dest[$ctr] = $$source[$idx[$ctr]];
                    424: 		$ctr++;
                    425: 	    }
                    426: 	}
1.27      ng        427:     }
                    428: }
                    429: 
                    430: sub rmap {
                    431:     my ($phrase,$dest,$source)=@_;
                    432:     my @seed = &random_seed_from_phrase($phrase);
                    433:     &random_set_seed(@seed);
                    434:     my $destct = scalar(@$dest);
1.28      ng        435:     if (!$source) {
                    436: 	my @idx = &math_random_permuted_index($destct);
                    437: 	my $ctr = 0;
                    438: 	my @r_idx;
                    439: 	while ($ctr < $destct) {
                    440: 	    $r_idx[$idx[$ctr]] = $ctr;
                    441: 	    $ctr++;
                    442: 	}
                    443: 	my @output;
                    444: 	$ctr = 0;
                    445: 	while ($ctr < $destct) {
                    446: 	    $output[$ctr] = $$dest[$r_idx[$ctr]];
1.27      ng        447: 	    $ctr++;
1.28      ng        448: 	}
                    449: 	return @output;
1.27      ng        450:     } else {
1.28      ng        451: 	my $num = scalar(@$source);
                    452: 	my @idx = &math_random_permuted_index($num);
                    453: 	my $ctr = 0;
                    454: 	my $tot = $num;
                    455: 	$tot = $destct if $destct < $num;
                    456: 	my @r_idx;
1.27      ng        457: 	while ($ctr < $tot) {
1.28      ng        458: 	    $r_idx[$idx[$ctr]] = $ctr;
1.27      ng        459: 	    $ctr++;
1.28      ng        460: 	}
                    461: 	$ctr = 0;
                    462: 	if (ref($$dest[0])) {
                    463: 	    while ($ctr < $tot) {
                    464: 		${$$dest[$ctr]} = $$source[$r_idx[$ctr]];
                    465: 	        $ctr++;
                    466:             }
                    467:         } else {
                    468: 	    while ($ctr < $tot) {
                    469: 		$$dest[$ctr] = $$source[$r_idx[$ctr]];
                    470: 		$ctr++;
                    471: 	    }
                    472: 	}
1.6       albertel  473:     }
1.5       albertel  474: }
1.22      ng        475: 
1.23      ng        476: sub capa_id { return }
                    477: 
                    478: sub problem { return }
                    479: 
1.22      ng        480: sub name{
                    481:   my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename');
                    482:   $fullname = "" if $fullname eq ",  ";
1.26      ng        483:   $fullname =~ s/\%2d/-/g;
1.22      ng        484:   return $fullname;
                    485: }
                    486: 
                    487: sub student_number { 
                    488:   my $id = &EXT('environment.id');
                    489:   $id = '' if $id eq "";
                    490:   return $id;
                    491: }
                    492: 
                    493: sub class {
                    494:   my $course = &EXT('course.description');
                    495:   $course = '' if $course eq "";
                    496:   return $course;
                    497: }
                    498: 
                    499: sub sec { 
                    500:   my $sec = &EXT('request.course.sec');
1.23      ng        501:   $sec = '' if $sec eq "";
1.22      ng        502:   return $sec;
                    503: }
                    504: 
1.23      ng        505: sub open_date { 
                    506:   my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate')));
1.24      ng        507:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    508:   my @hm = split(/:/,$dc[3]);
                    509:   my $ampm = " am";
                    510:   if ($hm[0] > 12) {
                    511:     $hm[0]-=12;
                    512:     $ampm = " pm";
                    513:   }
                    514:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
1.23      ng        515: }
                    516: 
                    517: sub due_date { 
                    518:   my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate')));
1.24      ng        519:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    520:   my @hm = split(/:/,$dc[3]);
                    521:   my $ampm = " am";
                    522:   if ($hm[0] > 12) {
                    523:     $hm[0]-=12;
                    524:     $ampm = " pm";
                    525:   }
                    526:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
                    527: #  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
1.23      ng        528: }
                    529: 
                    530: sub answer_date { 
                    531:   my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate')));
1.24      ng        532:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    533:   my @hm = split(/:/,$dc[3]);
                    534:   my $ampm = " am";
                    535:   if ($hm[0] > 12) {
                    536:     $hm[0]-=12;
                    537:     $ampm = " pm";
                    538:   }
                    539:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
                    540: #  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
                    541: }
                    542: 
                    543: sub array_moments {
                    544:   my @input=@_;
                    545:   my (@output,$N);
                    546:   $N=scalar (@input);
                    547:   $output[0]=$N;
                    548:   if ($N <= 1) {
                    549:     $output[1]=$input[0];
1.28      ng        550:     $output[1]="Input array not defined" if ($N == 0);
1.24      ng        551:     $output[2]="variance undefined for N<=1";
                    552:     $output[3]="skewness undefined for N<=1";
                    553:     $output[4]="kurtosis undefined for N<=1";
                    554:     return @output;
                    555:   }
                    556:   my $sum=0;
                    557:   foreach my $line (@input) {
                    558:     $sum+=$line;
                    559:   }
                    560:   $output[1] = $sum/$N;
                    561:   my ($x,$sdev,$var,$skew,$kurt) = 0;
                    562:   foreach my $line (@input) {
                    563:     $x=$line-$output[1];
                    564:     $var+=$x**2;
                    565:     $skew+=$x**3;
                    566:     $kurt+=$x**4;
                    567:   }
                    568:   $output[2]=$var/($N-1);
                    569:   $sdev=sqrt($output[2]);
                    570:   if ($sdev == 0) {
                    571:      $output[3]="inf-variance=0";
                    572:      $output[4]="inf-variance=0";
                    573:      return @output;
                    574:   }
                    575:   $output[3]=$skew/($sdev**3*$N);
                    576:   $output[4]=$kurt/($sdev**4*$N)-3;
                    577:   return @output;
                    578: }
1.5       albertel  579: 
                    580: sub choose {
                    581:   my $num = $_[0];
                    582:   return $_[$num];
                    583: }
1.23      ng        584: 
                    585: 

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