![]() ![]() | ![]() |
- less ambiguous - remove repeat definition
1: # The LearningOnline Network with CAPA 2: # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run() 3: # 4: # $Id: default_homework.lcpm,v 1.59 2003/03/25 23:00:18 albertel Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # 29: # Guy Albertelli 30: # 31: # 05/25/2001 H. K. Ng 32: # 05/31/2001 H. K. Ng 33: # 12/21/2001 Matthew 34: # 35: #init some globals 36: $hidden::RANDOMINIT=0; 37: $pi=atan2(1,1)*4; 38: $rad2deg=180.0/$pi; 39: $deg2rad=$pi/180.0; 40: $"=' '; 41: 42: sub caparesponse_check { 43: #not properly used yet: calc 44: #not to be used: $ans_fmt 45: my ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc,$samples) = 46: eval $_[1]. 47: ';return ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc,$samples);'; 48: 49: my $tol_type=''; # gets it's value from whether tol has a % or not done 50: my $sig_lbound=''; #done 51: my $sig_ubound=''; #done 52: my ($response,$expr)=@_; 53: 54: 55: #type's definitons come from capaParser.h 56: my $message=''; 57: #remove leading and trailing whitespace 58: if ($response=~ /^\s|\s$/) { 59: $response=~ s:^\s+|\s+$::g; 60: $message .="Removed ws now :$response:\n"; 61: } else { 62: $message .="no ws in :$response:\n"; 63: } 64: 65: if ($type eq '' ) { 66: $message .= "Didn't find a type :$type:$expr: defaulting\n"; 67: if ( $answer eq ($answer *1.0)) { $type = 2; 68: } else { $type = 3; } 69: } else { 70: if ($type eq 'cs') { $type = 4; 71: } elsif ($type eq 'ci') { $type = 3; 72: } elsif ($type eq 'mc') { $type = 5; 73: } elsif ($type eq 'fml') { $type = 8; 74: } elsif ($type eq 'subj') { $type = 7; 75: } elsif ($type eq 'float') { $type = 2; 76: } elsif ($type eq 'int') { $type = 1; 77: } else { return "ERROR: Unknown type of answer: $type" } 78: } 79: 80: my $points; 81: my $id_list; 82: #formula type setup the sample points 83: if ($type eq '8') { 84: ($id_list,$points)=split(/@/,$samples); 85: $message.="Found :$points: points\n"; 86: } 87: if ($tol eq '') { 88: $tol=0.0; 89: $tol_type=1; #TOL_ABSOLUTE 90: } else { 91: if ($tol =~ /%$/) { 92: chop $tol; 93: $tol_type=2; #TOL_PERCENTAGE 94: } else { 95: $tol_type=1; #TOL_ABSOLUTE 96: } 97: } 98: 99: if ($sig eq '') { 100: $sig_lbound = 0; #SIG_LB_DEFAULT 101: $sig_ubound =15; #SIG_UB_DEFAULT 102: } else { 103: ($sig_lbound,$sig_ubound) = split /,/,$sig; 104: if (!defined($sig_lbound)) { 105: $sig_lbound = 0; #SIG_LB_DEFAULT 106: $sig_ubound =15; #SIG_UB_DEFAULT 107: } 108: if (!defined($sig_ubound)) { $sig_ubound=$sig_lbound; } 109: } 110: my $result = &caparesponse_capa_check_answer($response,$answer,$type, 111: $tol_type,$tol, 112: $sig_lbound,$sig_ubound, 113: $ans_fmt,$unit,$calc,$id_list, 114: $points,$external::randomseed); 115: 116: if ($result == '1') { $result='EXACT_ANS'; } 117: elsif ($result == '2') { $result='APPROX_ANS'; } 118: elsif ($result == '3') { $result='SIG_FAIL'; } 119: elsif ($result == '4') { $result='UNIT_FAIL'; } 120: elsif ($result == '5') { $result='NO_UNIT'; } 121: elsif ($result == '6') { $result='UNIT_OK'; } 122: elsif ($result == '7') { $result='INCORRECT'; } 123: elsif ($result == '8') { $result='UNIT_NOTNEEDED'; } 124: elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; } 125: elsif ($result =='10') { $result='SUB_RECORDED'; } 126: elsif ($result =='11') { $result='BAD_FORMULA'; } 127: elsif ($result =='12') { $result='WANTED_NUMERIC'; } 128: else {$result = "ERROR: Unknown Result:$result:$@:";} 129: 130: return "$result:\nError $error:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message$expr"; 131: } 132: 133: sub get_array_args { 134: my ($expr,$arg)=@_; 135: # do these first, because who knows what varname the instructor might have used 136: # but it probably isn't $CAPARESPONSE_CHECK_LIST_answer 137: my $CAPARESPONSE_CHECK_LIST_answer = eval $expr.';return $'.$arg; #' 138: my $GET_ARRAY_ARGS_result; 139: my @GET_ARRAY_ARGS_list; 140: if ($CAPARESPONSE_CHECK_LIST_answer =~ /^\s*[\$\@]/) { 141: (@GET_ARRAY_ARGS_list) = eval $CAPARESPONSE_CHECK_LIST_answer; 142: } 143: $GET_ARRAY_ARGS_result.="error:$@:\n"; 144: # if the eval fails just use what is in the answer exactly 145: if (!defined(@GET_ARRAY_ARGS_list) || !defined($GET_ARRAY_ARGS_list[0])) { 146: $GET_ARRAY_ARGS_result.="list zero is undefined\n"; 147: $GET_ARRAY_ARGS_list[0]=$CAPARESPONSE_CHECK_LIST_answer; 148: } 149: return $GET_ARRAY_ARGS_result,@GET_ARRAY_ARGS_list; 150: } 151: 152: sub caparesponse_check_list { 153: my ($response,$expr)=@_; 154: my $result; 155: $expr =~ s/\\/\\\\/g; 156: $expr =~ s/\'/\\\'/g; 157: my ($result,@list) = &get_array_args($expr,'answer'); 158: my $aresult=''; 159: my $current_answer; 160: my $answers=join(':',@list); 161: $result.="Got response :$answers:\n"; 162: my @responselist; 163: my $type =eval $expr.';return $answer;'; 164: if ($type ne '' && $#list > 0) { 165: (@responselist)=split /,/,$response; 166: } else { 167: (@responselist)=($response); 168: } 169: my $unit=''; 170: $result.="Initial final response :$responselist['-1']:\n"; 171: if ($type eq '') { 172: #for numerical problems split off the unit 173: if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) { 174: $responselist['-1']=$1; 175: $unit=$2; 176: } 177: } 178: $result.="Final final response :$responselist['-1']:\n"; 179: $result.=":$#list: answers\n"; 180: $unit=~s/\s//; 181: my $i=0; 182: my $awards=''; 183: for ($i=0; $i<@list;$i++) { 184: $result.="trying answer :$list[$i]:\n"; 185: my $thisanswer=$list[$i]; 186: $thisanswer=~ s/\\/\\\\/g; 187: $thisanswer =~ s/\'/\\\'/g; 188: if ($unit eq '') { 189: $aresult=&caparesponse_check($responselist[$i], 190: $expr.';my $answer=\''.$thisanswer.'\';'); 191: } else { 192: $aresult=&caparesponse_check($responselist[$i]." $unit", 193: $expr.';my $answer=\''.$thisanswer.'\';'); 194: } 195: my ($temp)=split /:/, $aresult; 196: $awards.="$temp,"; 197: $result.=$aresult; 198: } 199: chop $awards; 200: return "$awards:\n$result"; 201: } 202: 203: sub tex { 204: if ( $external::target eq "tex" ) { 205: return $_[0]; 206: } else { 207: return $_[1]; 208: } 209: } 210: 211: sub var_in_tex { 212: if ( $external::target eq "tex" ) { 213: return $_[0]; 214: } else { 215: return ""; 216: } 217: } 218: 219: sub web { 220: if ( $external::target eq "tex" ) { 221: return $_[1]; 222: } else { 223: if ( $external::target eq "web" || $external::target eq "answer") { 224: return $_[2]; 225: } else { 226: return $_[0]; 227: } 228: } 229: } 230: 231: sub html { 232: if ( $external::target eq "web" ) { 233: return shift; 234: } 235: } 236: 237: sub hinton { 238: return 0; 239: } 240: 241: sub random { 242: my ($start,$end,$step)=@_; 243: if ( ! $hidden::RANDOMINIT ) { 244: if ($external::randomseed == 0) { $external::randomseed=1; } 245: &random_set_seed(1,int(abs($external::randomseed))); 246: &math_random_uniform(); 247: $hidden::RANDOMINIT=1; 248: } 249: if (!defined($step)) { $step=1; } 250: my $num=1+int(($end-$start)/$step); 251: my $result=$start + int(&math_random_uniform() * $num)*$step; 252: return $result; 253: } 254: 255: sub random_normal { 256: my ($item_cnt,$seed,$av,$std_dev) = @_; 257: my @oldseed=&random_get_seed(); 258: my @retArray; 259: &random_set_seed_from_phrase($seed); 260: @retArray=&math_random_normal($item_cnt,$av,$std_dev); 261: &random_set_seed(@oldseed); 262: return @retArray; 263: } 264: 265: sub random_beta { 266: my ($item_cnt,$seed,$aa,$bb) = @_; 267: my @oldseed=&random_get_seed(); 268: my @retArray; 269: &random_set_seed_from_phrase($seed); 270: @retArray=&math_random_beta($item_cnt,$aa,$bb); 271: &random_set_seed(@oldseed); 272: return @retArray; 273: } 274: 275: sub random_gamma { 276: my ($item_cnt,$seed,$a,$r) = @_; 277: my @oldseed=&random_get_seed(); 278: my @retArray; 279: &random_set_seed_from_phrase($seed); 280: @retArray=&math_random_gamma($item_cnt,$a,$r); 281: &random_set_seed(@oldseed); 282: return @retArray; 283: } 284: 285: sub random_exponential { 286: my ($item_cnt,$seed,$av) = @_; 287: my @oldseed=&random_get_seed(); 288: my @retArray; 289: &random_set_seed_from_phrase($seed); 290: @retArray=&math_random_exponential($item_cnt,$av); 291: &random_set_seed(@oldseed); 292: return @retArray; 293: } 294: 295: sub random_poisson { 296: my ($item_cnt,$seed,$mu) = @_; 297: my @oldseed=&random_get_seed(); 298: my @retArray; 299: &random_set_seed_from_phrase($seed); 300: @retArray=&math_random_poisson($item_cnt,$mu); 301: &random_set_seed(@oldseed); 302: return @retArray; 303: } 304: 305: sub random_chi { 306: my ($item_cnt,$seed,$df) = @_; 307: my @oldseed=&random_get_seed(); 308: my @retArray; 309: &random_set_seed_from_phrase($seed); 310: @retArray=&math_random_chi_square($item_cnt,$df); 311: &random_set_seed(@oldseed); 312: return @retArray; 313: } 314: 315: sub random_noncentral_chi { 316: my ($item_cnt,$seed,$df,$nonc) = @_; 317: my @oldseed=&random_get_seed(); 318: my @retArray; 319: &random_set_seed_from_phrase($seed); 320: @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc); 321: &random_set_seed(@oldseed); 322: return @retArray; 323: } 324: 325: sub random_f { 326: my ($item_cnt,$seed,$dfn,$dfd) = @_; 327: my @oldseed=&random_get_seed(); 328: my @retArray; 329: &random_set_seed_from_phrase($seed); 330: @retArray=&math_random_f($item_cnt,$dfn,$dfd); 331: &random_set_seed(@oldseed); 332: return @retArray; 333: } 334: 335: sub random_noncentral_f { 336: my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_; 337: my @oldseed=&random_get_seed(); 338: my @retArray; 339: &random_set_seed_from_phrase($seed); 340: @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc); 341: &random_set_seed(@oldseed); 342: return @retArray; 343: } 344: 345: sub random_multivariate_normal { 346: my ($item_cnt,$seed,$mean,$covar) = @_; 347: my @oldseed=&random_get_seed(); 348: &random_set_seed_from_phrase($seed); 349: @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar); 350: &random_set_seed(@oldseed); 351: return @retArray; 352: } 353: 354: sub random_multinomial { 355: my ($item_cnt,$seed,@p) = @_; 356: my @oldseed=&random_get_seed(); 357: my @retArray; 358: &random_set_seed_from_phrase($seed); 359: @retArray=&math_random_multinomial($item_cnt,@p); 360: &random_set_seed(@oldseed); 361: return @retArray; 362: } 363: 364: sub random_permutation { 365: my ($seed,@inArray) = @_; 366: my @oldseed=&random_get_seed(); 367: my @retArray; 368: &random_set_seed_from_phrase($seed); 369: @retArray=&math_random_permutation(@inArray); 370: &random_set_seed(@oldseed); 371: return @retArray; 372: } 373: 374: sub random_uniform { 375: my ($item_cnt,$seed,$low,$high) = @_; 376: my @oldseed=&random_get_seed(); 377: my @retArray; 378: &random_set_seed_from_phrase($seed); 379: @retArray=&math_random_uniform($item_cnt,$low,$high); 380: &random_set_seed(@oldseed); 381: return @retArray; 382: } 383: 384: sub random_uniform_integer { 385: my ($item_cnt,$seed,$low,$high) = @_; 386: my @oldseed=&random_get_seed(); 387: my @retArray; 388: &random_set_seed_from_phrase($seed); 389: @retArray=&math_random_uniform_integer($item_cnt,$low,$high); 390: &random_set_seed(@oldseed); 391: return @retArray; 392: } 393: 394: sub random_binomial { 395: my ($item_cnt,$seed,$nt,$p) = @_; 396: my @oldseed=&random_get_seed(); 397: my @retArray; 398: &random_set_seed_from_phrase($seed); 399: @retArray=&math_random_binomial($item_cnt,$nt,$p); 400: &random_set_seed(@oldseed); 401: return @retArray; 402: } 403: 404: sub random_negative_binomial { 405: my ($item_cnt,$seed,$ne,$p) = @_; 406: my @oldseed=&random_get_seed(); 407: my @retArray; 408: &random_set_seed_from_phrase($seed); 409: @retArray=&math_random_negative_binomial($item_cnt,$ne,$p); 410: &random_set_seed(@oldseed); 411: return @retArray; 412: } 413: 414: sub abs { abs(shift) } 415: sub sin { sin(shift) } 416: sub cos { cos(shift) } 417: sub exp { exp(shift) } 418: sub int { int(shift) } 419: sub log { log(shift) } 420: sub atan2 { atan2($_[0],$_[1]) } 421: sub sqrt { sqrt(shift) } 422: 423: sub tan { CORE::sin($_[0]) / CORE::cos($_[0]) } 424: #sub atan { atan2($_[0], 1); } 425: #sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); } 426: #sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) ); } 427: 428: sub log10 { CORE::log($_[0])/CORE::log(10); } 429: 430: sub factorial { 431: my $input = CORE::int(shift); 432: return "Error - unable to take factorial of an negative number ($input)" if $input < 0; 433: return "Error - factorial result is greater than system limit ($input)" if $input > 170; 434: return 1 if $input == 0; 435: my $result = 1; 436: for (my $i=2; $i<=$input; $i++) { $result *= $i } 437: return $result; 438: } 439: 440: sub sgn { 441: return -1 if $_[0] < 0; 442: return 0 if $_[0] == 0; 443: return 1 if $_[0] > 0; 444: } 445: 446: sub min { 447: my @sorted = sort { $a <=> $b || $a cmp $b } @_; 448: return shift @sorted; 449: } 450: 451: sub max { 452: my @sorted = sort { $a <=> $b || $a cmp $b } @_; 453: return pop @sorted; 454: } 455: 456: sub roundto { 457: my ($input,$n) = @_; 458: return sprintf('%.'.$n.'f',$input); 459: } 460: 461: sub to_string { 462: my ($input,$n) = @_; 463: return sprintf($input) if $n eq ""; 464: $n = '.'.$n if $n !~ /^\./; 465: return sprintf('%'.$n,$input) if $n ne ""; 466: } 467: 468: sub sub_string { 469: my ($str,$start,$len) = @_; 470: return substr($str,$start-1,$len); 471: } 472: 473: sub pow {return $_[0] ** $_[1]; } 474: sub ceil {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? (CORE::int($_[0])+ 1) : CORE::int($_[0])); } 475: sub floor {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? CORE::int($_[0]) : (CORE::int($_[0])-1)); } 476: #sub floor {return int($_[0]); } 477: 478: sub format { 479: my ($value,$fmt)=@_; 480: my $dollarmode; 481: if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } 482: my $result=sprintf('%.'.$fmt,$value); 483: $result=~s/(E[+-]*)0/$1/; 484: if ($dollarmode) {$result=&dollarmode($result);} 485: return $result; 486: } 487: 488: sub prettyprint { 489: my ($value,$fmt)=@_; 490: my $result; 491: my $dollarmode; 492: if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } 493: if ($fmt) { $value=sprintf('%.'.$fmt,$value); } 494: if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/ ) { 495: my $frac=$1; 496: if ($dollarmode) { $frac=&dollarformat($frac); } 497: my $exponent=$2; 498: $exponent=~s/^\+0*//; 499: $exponent=~s/^-0*/-/; 500: if ($exponent) { 501: if ($external::target eq 'web') { 502: $result=$frac.'×10<sup>'.$exponent.'</sup>'; 503: } elsif ($external::target eq 'tex') { 504: $result='\ensuremath{'.$frac.'\times 10^{'.$exponent.'}}'; 505: } else { 506: $result=$value; 507: } 508: } else { 509: $result=$frac; 510: } 511: } else { 512: $result=$value; 513: if ($dollarmode) { $result=&dollarformat($result); } 514: } 515: return $result; 516: } 517: 518: sub dollarformat { 519: my ($number) = @_; 520: if ($number =~ /\./) { 521: while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*$)/) { 522: $number = $1.','.$2.$3; 523: } 524: } else { 525: while ($number =~ /([^,]+)([^,][^,][^,])([,0-9]*)$/) { 526: $number = $1.','.$2.$3; 527: } 528: } 529: if ($external::target eq 'tex') { 530: $number='\$'.$number; #' stupid emacs 531: } else { 532: $number='$'.$number; #' stupid emacs 533: } 534: return $number; 535: } 536: 537: sub map { 538: my ($phrase,$dest,$source)=@_; 539: my @oldseed=&random_get_seed(); 540: my @seed = &random_seed_from_phrase($phrase); 541: &random_set_seed(@seed); 542: my $destct = scalar(@$dest); 543: if (!$source) { 544: my @output; 545: my @idx = &math_random_permuted_index($destct); 546: my $ctr = 0; 547: while ($ctr < $destct) { 548: $output[$ctr] = $$dest[$idx[$ctr]]; 549: $ctr++; 550: } 551: &random_set_seed(@oldseed); 552: return @output; 553: } else { 554: my $num = scalar(@$source); 555: my @idx = &math_random_permuted_index($num); 556: my $ctr = 0; 557: my $tot = $num; 558: $tot = $destct if $destct < $num; 559: if (ref($$dest[0])) { 560: while ($ctr < $tot) { 561: ${$$dest[$ctr]} = $$source[$idx[$ctr]]; 562: $ctr++; 563: } 564: } else { 565: while ($ctr < $tot) { 566: $$dest[$ctr] = $$source[$idx[$ctr]]; 567: $ctr++; 568: } 569: } 570: } 571: &random_set_seed(@oldseed); 572: return ''; 573: } 574: 575: sub rmap { 576: my ($phrase,$dest,$source)=@_; 577: my @oldseed=&random_get_seed(); 578: my @seed = &random_seed_from_phrase($phrase); 579: &random_set_seed(@seed); 580: my $destct = scalar(@$dest); 581: if (!$source) { 582: my @idx = &math_random_permuted_index($destct); 583: my $ctr = 0; 584: my @r_idx; 585: while ($ctr < $destct) { 586: $r_idx[$idx[$ctr]] = $ctr; 587: $ctr++; 588: } 589: my @output; 590: $ctr = 0; 591: while ($ctr < $destct) { 592: $output[$ctr] = $$dest[$r_idx[$ctr]]; 593: $ctr++; 594: } 595: &random_set_seed(@oldseed); 596: return @output; 597: } else { 598: my $num = scalar(@$source); 599: my @idx = &math_random_permuted_index($num); 600: my $ctr = 0; 601: my $tot = $num; 602: $tot = $destct if $destct < $num; 603: my @r_idx; 604: while ($ctr < $tot) { 605: $r_idx[$idx[$ctr]] = $ctr; 606: $ctr++; 607: } 608: $ctr = 0; 609: if (ref($$dest[0])) { 610: while ($ctr < $tot) { 611: ${$$dest[$ctr]} = $$source[$r_idx[$ctr]]; 612: $ctr++; 613: } 614: } else { 615: while ($ctr < $tot) { 616: $$dest[$ctr] = $$source[$r_idx[$ctr]]; 617: $ctr++; 618: } 619: } 620: } 621: &random_set_seed(@oldseed); 622: return ''; 623: } 624: 625: sub capa_id { return } 626: 627: sub problem { return } 628: 629: sub name{ 630: my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename'); 631: $fullname = "" if $fullname eq ", "; 632: $fullname =~ s/\%2d/-/g; 633: return $fullname; 634: } 635: 636: sub student_number { 637: my $id = &EXT('environment.id'); 638: $id = '' if $id eq ""; 639: return $id; 640: } 641: 642: sub class { 643: my $course = &EXT('course.description'); 644: $course = '' if $course eq ""; 645: return $course; 646: } 647: 648: sub sec { 649: my $sec = &EXT('request.course.sec'); 650: $sec = '' if $sec eq ""; 651: return $sec; 652: } 653: 654: sub open_date { 655: my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate'))); 656: return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969); 657: my @hm = split(/:/,$dc[3]); 658: my $ampm = " am"; 659: if ($hm[0] > 12) { 660: $hm[0]-=12; 661: $ampm = " pm"; 662: } 663: return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm; 664: } 665: 666: sub due_date { 667: my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate'))); 668: return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969); 669: my @hm = split(/:/,$dc[3]); 670: my $ampm = " am"; 671: if ($hm[0] > 12) { 672: $hm[0]-=12; 673: $ampm = " pm"; 674: } 675: return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm; 676: # return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3]; 677: } 678: 679: sub answer_date { 680: my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate'))); 681: return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969); 682: my @hm = split(/:/,$dc[3]); 683: my $ampm = " am"; 684: if ($hm[0] > 12) { 685: $hm[0]-=12; 686: $ampm = " pm"; 687: } 688: return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm; 689: # return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3]; 690: } 691: 692: sub array_moments { 693: my @input=@_; 694: my (@output,$N); 695: $N=scalar (@input); 696: $output[0]=$N; 697: if ($N <= 1) { 698: $output[1]=$input[0]; 699: $output[1]="Input array not defined" if ($N == 0); 700: $output[2]="variance undefined for N<=1"; 701: $output[3]="skewness undefined for N<=1"; 702: $output[4]="kurtosis undefined for N<=1"; 703: return @output; 704: } 705: my $sum=0; 706: foreach my $line (@input) { 707: $sum+=$line; 708: } 709: $output[1] = $sum/$N; 710: my ($x,$sdev,$var,$skew,$kurt) = 0; 711: foreach my $line (@input) { 712: $x=$line-$output[1]; 713: $var+=$x**2; 714: $skew+=$x**3; 715: $kurt+=$x**4; 716: } 717: $output[2]=$var/($N-1); 718: $sdev=CORE::sqrt($output[2]); 719: if ($sdev == 0) { 720: $output[3]="inf-variance=0"; 721: $output[4]="inf-variance=0"; 722: return @output; 723: } 724: $output[3]=$skew/($sdev**3*$N); 725: $output[4]=$kurt/($sdev**4*$N)-3; 726: return @output; 727: } 728: 729: sub choose { 730: my $num = $_[0]; 731: return $_[$num]; 732: } 733: 734: # expiremental idea 735: sub proper_path { 736: my ($path)=@_; 737: if ( $external::target eq "tex" ) { 738: return '/home/httpd/html'.$path; 739: } else { 740: return $path; 741: } 742: } 743: