loncom/homework/default_homework.lcpm - view

File: [LON-CAPA] / loncom / homework / default_homework.lcpm
Revision 1.71: download - view: text, annotated - select for diffs
Fri Mar 12 21:06:19 2004 UTC (20 years, 2 months ago) by albertel
Branches: MAIN
CVS tags: HEAD

- BUG# Lots, lets start with 186,32,220,870
- when checking unit,sigfig etctera, we want to tell the student what we think they enetered, need to get the error string out of the C code and into perl space.
- Still need to do something with the message but at lest we have it now
- <numericalhint> properl namespace it's vars now.

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