Annotation of loncom/homework/default_homework.lcpm, revision 1.116
1.42 albertel 1: # The LearningOnline Network with CAPA
1.1 harris41 2: # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
1.42 albertel 3: #
1.116 ! albertel 4: # $Id: default_homework.lcpm,v 1.115 2006/07/28 15:22:28 www Exp $
1.42 albertel 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: #
1.20 harris41 28: #
1.76 albertel 29:
1.25 albertel 30: #init some globals
1.38 albertel 31: $hidden::RANDOMINIT=0;
1.22 ng 32: $pi=atan2(1,1)*4;
33: $rad2deg=180.0/$pi;
34: $deg2rad=$pi/180.0;
1.44 matthew 35: $"=' ';
1.116 ! albertel 36: use strict;
! 37: {
! 38: my $n = 0;
! 39: my $total = 0;
! 40: my $num_left = 0;
! 41: my @order;
! 42: my $type;
! 43:
! 44: sub init_permutation {
! 45: my ($size,$requested_type) = @_;
! 46: @order = (0..$size-1);
! 47: $n = $size;
! 48: $type = $requested_type;
! 49: if ($type eq 'ordered') {
! 50: $total = $num_left = 1;
! 51: } elsif ($type eq 'unordered') {
! 52: $total = $num_left = &factorial($size);
! 53: } else {
! 54: die("Unkown type: $type");
! 55: }
! 56: }
! 57:
! 58: sub get_next_permutation {
! 59: if ($num_left == $total) {
! 60: $num_left--;
! 61: return @order;
! 62: }
! 63:
! 64: # Find largest index j with a[j] < a[j+1]
! 65:
! 66: my $j = scalar(@order) - 2;
! 67: while ($order[$j] > $order[$j+1]) {
! 68: $j--;
! 69: }
! 70:
! 71: # Find index k such that a[k] is smallest integer
! 72: # greater than a[j] to the right of a[j]
! 73:
! 74: my $k = scalar(@order) - 1;
! 75: while ($order[$j] > $order[$k]) {
! 76: $k--;
! 77: }
! 78:
! 79: # Interchange a[j] and a[k]
! 80:
! 81: @order[($k,$j)] = @order[($j,$k)];
! 82:
! 83: # Put tail end of permutation after jth position in increasing order
! 84:
! 85: my $r = scalar(@order) - 1;
! 86: my $s = $j + 1;
! 87:
! 88: while ($r > $s) {
! 89: @order[($s,$r)]=@order[($r,$s)];
! 90: $r--;
! 91: $s++;
! 92: }
! 93:
! 94: $num_left--;
! 95: return(@order);
! 96: }
! 97:
! 98: sub get_permutations_left {
! 99: return $num_left;
! 100: }
! 101: }
1.3 albertel 102:
1.91 albertel 103: sub check_commas {
104: my ($response)=@_;
105: #print("$response ");
106: my @numbers=split(',',$response);
107: #print(" numbers ".join('-',@numbers)." ");
108: if (scalar(@numbers) > 1) {
109: #print(" numbers[0] ".$numbers[0]." ");
110: if (length($numbers[0]) > 3 || length($numbers[0]) == 0) { return -1; }
111: shift(@numbers);
112: #print(" numbers ".scalar(@numbers)." ");
113: while (scalar(@numbers) > 1) {
114: #print(" numbers ".join('-',@numbers)." ");
115: if (length($numbers[0]) != 3) { return -2; }
116: shift(@numbers);
117: }
118: my ($number)=split('\.',$numbers[0]);
119: #print(" number ".$number." ");
120: #print(" numbers[0] ".$numbers[0]." ");
121: if (length($number) != 3) { return -3; }
122: } else {
123: my ($number)=split('\.',$numbers[0]);
124: if (length($number) > 3) { return -4; }
125: }
126: return 1;
127: }
128:
1.7 albertel 129: sub caparesponse_check {
1.74 albertel 130: my ($answer,$response)=@_;
1.73 albertel 131: #not properly used yet: calc
132: #not to be used: $ans_fmt
1.74 albertel 133: my $type=$LONCAPA::CAPAresponse_args{'type'};
134: my $tol=$LONCAPA::CAPAresponse_args{'tol'};
135: my $sig=$LONCAPA::CAPAresponse_args{'sig'};
1.88 albertel 136: my $ans_fmt=$LONCAPA::CAPAresponse_args{'format'};
1.74 albertel 137: my $unit=$LONCAPA::CAPAresponse_args{'unit'};
138: my $calc=$LONCAPA::CAPAresponse_args{'calc'};
139: my $samples=$LONCAPA::CAPAresponse_args{'samples'};
1.73 albertel 140:
141: my $tol_type=''; # gets it's value from whether tol has a % or not done
142: my $sig_lbound=''; #done
143: my $sig_ubound=''; #done
144:
145:
146: #type's definitons come from capaParser.h
1.116 ! albertel 147:
1.73 albertel 148: #remove leading and trailing whitespace
149: if (!defined($response)) {
150: $response='';
151: }
152: if ($response=~ /^\s|\s$/) {
153: $response=~ s:^\s+|\s+$::g;
1.116 ! albertel 154: &LONCAPA_INTENAL_DEBUG("Removed ws now :$response:");
1.73 albertel 155: }
1.116 ! albertel 156:
1.100 albertel 157: &LONCAPA_INTERNAL_DEBUG(" type is $type ");
158: if ($type eq 'cs' || $type eq 'ci') {
1.76 albertel 159: #for string answers make surec all places spaces occur, there is
160: #really only 1 space, in both the answer and the response
161: $answer=~s/ +/ /g;
162: $response=~s/ +/ /g;
1.100 albertel 163: } elsif ($type eq 'mc') {
164: $answer=~s/[\s,]//g;
165: $response=~s/[\s,]//g;
1.76 albertel 166: }
1.91 albertel 167: if ($type eq 'float' && $unit=~/\$/) {
1.88 albertel 168: if ($response!~/^\$/) { return "NO_UNIT: Missing \$ "; }
169: $response=~s/\$//g;
170: }
1.91 albertel 171: if ($type eq 'float' && $unit=~/\,/ && (&check_commas($response)<0)) {
172: return "COMMA_FAIL:";
173: }
1.88 albertel 174: $ans_fmt=~s/\W//g;
1.91 albertel 175: $unit=~s/[\$,]//g;
176: if ($type eq 'float') { $response=~s/,//g; }
1.88 albertel 177:
1.73 albertel 178: if (length($response) > 500) { return "TOO_LONG: Answer too long"; }
179:
180: if ($type eq '' ) {
1.116 ! albertel 181: &LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting");
1.73 albertel 182: if ( $answer eq ($answer *1.0)) { $type = 2;
183: } else { $type = 3; }
184: } else {
1.107 albertel 185: if ($type eq 'cs') { $type = 4; }
1.73 albertel 186: elsif ($type eq 'ci') { $type = 3 }
187: elsif ($type eq 'mc') { $type = 5; }
188: elsif ($type eq 'fml') { $type = 8; }
1.107 albertel 189: elsif ($type eq 'math') { $type = 9; }
1.73 albertel 190: elsif ($type eq 'subj') { $type = 7; }
191: elsif ($type eq 'float') { $type = 2; }
192: elsif ($type eq 'int') { $type = 1; }
193: else { return "ERROR: Unknown type of answer: $type" }
194: }
195:
196: my $points;
197: my $id_list;
198: #formula type setup the sample points
199: if ($type eq '8') {
200: ($id_list,$points)=split(/@/,$samples);
1.116 ! albertel 201: &LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples");
1.73 albertel 202: }
203: if ($tol eq '') {
204: $tol=0.0;
205: $tol_type=1; #TOL_ABSOLUTE
206: } else {
207: if ($tol =~ /%$/) {
208: chop $tol;
209: $tol_type=2; #TOL_PERCENTAGE
210: } else {
211: $tol_type=1; #TOL_ABSOLUTE
212: }
213: }
214:
1.85 albertel 215: ($sig_ubound,$sig_lbound)=&LONCAPA_INTERNAL_get_sigrange($sig);
216:
1.73 albertel 217: my $reterror="";
1.107 albertel 218: my $result;
219: if ($type eq '9') {
1.108 www 220: $result = &maxima_check(&maxima_cas_formula_fix($response),&maxima_cas_formula_fix($answer),\$reterror);
1.107 albertel 221: } else {
1.109 albertel 222: if ($type eq '8') { # fml type
223: $response = &capa_formula_fix($response);
224: $answer = &capa_formula_fix($answer);
225: }
226: $result = &caparesponse_capa_check_answer($response,$answer,$type,
1.73 albertel 227: $tol_type,$tol,
228: $sig_lbound,$sig_ubound,
229: $ans_fmt,$unit,$calc,$id_list,
230: $points,$external::randomseed,
231: \$reterror);
1.107 albertel 232: }
1.73 albertel 233: if ($result == '1') { $result='EXACT_ANS'; }
234: elsif ($result == '2') { $result='APPROX_ANS'; }
235: elsif ($result == '3') { $result='SIG_FAIL'; }
236: elsif ($result == '4') { $result='UNIT_FAIL'; }
237: elsif ($result == '5') { $result='NO_UNIT'; }
238: elsif ($result == '6') { $result='UNIT_OK'; }
239: elsif ($result == '7') { $result='INCORRECT'; }
240: elsif ($result == '8') { $result='UNIT_NOTNEEDED'; }
241: elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; }
242: elsif ($result =='10') { $result='SUB_RECORDED'; }
243: elsif ($result =='11') { $result='BAD_FORMULA'; }
1.94 albertel 244: elsif ($result =='12' && !$response) { $result='MISSING_ANSWER'; }
245: elsif ($result =='12') { $result='WANTED_NUMERIC'; }
1.77 albertel 246: elsif ($result =='13') { $result='UNIT_INVALID_INSTRUCTOR'; }
247: elsif ($result =='141') { $result='UNIT_INVALID_STUDENT'; }
248: elsif ($result =='142') { $result='UNIT_INVALID_STUDENT'; }
249: elsif ($result =='143') { $result='UNIT_INVALID_STUDENT'; }
250: elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; }
1.73 albertel 251: else {$result = "ERROR: Unknown Result:$result:$@:";}
252:
1.116 ! albertel 253: &LONCAPA_INTERNAL_DEBUG("RetError $reterror: Answer $answer: Response $response: type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|",$reterror);
! 254: return ($result,$reterror)
1.37 albertel 255: }
256:
1.108 www 257: sub maxima_cas_formula_fix {
258: my ($expression)=@_;
259: return &implicit_multiplication($expression);
260: }
261:
262: sub capa_formula_fix {
263: my ($expression)=@_;
264: return &implicit_multiplication($expression);
265: }
266:
267: sub implicit_multiplication {
268: my ($expression)=@_;
1.111 www 269: # Escape scientific notation, so 3e8 does not become 3*e*8
270: # 3e8 -> 3&8; 3e-8 -> 3&-8; 3E+8 -> e&+8
1.110 www 271: $expression=~s/(\d+)e([\+\-]*\d+)/$1\&\($2\)/gsi;
1.111 www 272: # 3x10^8 -> 3&8; 3*10^-8 -> 3&-8
1.110 www 273: $expression=~s/(\d+)(?:x|\*)10(?:\^|\*\*)([\+\-]*\d+)/$1\&\($2\)/gsi;
1.111 www 274: # Fill in multiplication signs
1.114 albertel 275: # a b -> a*b;3 b -> 3*b;3 4 -> 3*4
276: $expression=~s/(\w)\s+(\w)/$1\*$2/gs;
1.115 www 277: # )( -> )*(; ) ( -> )*(
278: $expression=~s/\)\s*\(/\)\*\(/gs;
279: # 3a -> 3*a; 3( -> 3*(; 3 ( -> 3*(; 3A -> 3*A
280: $expression=~s/(\d)\s*([a-zA-Z\(])/$1\*$2/gs;
281: # a ( -> a*(
282: $expression=~s/(\w)\s+\(/$1\*\(/gs;
1.113 www 283: # a3 -> a*3;
1.110 www 284: $expression=~s/([a-zA-Z])(\d)/$1\*$2/gs;
1.115 www 285: # )a -> )*a; )3 -> )*3; ) 3 -> )*3
286: $expression=~s/\)\s*(\w)/\)\*$1/gs;
1.111 www 287: # 3&8 -> 3e8; 3&-4 -> 3e-4
1.110 www 288: $expression=~s/(\d+)\&\(([\+\-]*\d+)\)/$1e$2/gs;
1.108 www 289: return $expression;
290: }
1.73 albertel 291:
1.37 albertel 292: sub caparesponse_check_list {
1.74 albertel 293: my $response=$LONCAPA::CAPAresponse_args{'response'};
1.105 albertel 294: my $result="Got response :".join(':',@LONCAPA::CAPAresponse_answer).":\n";
295: &LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args));
1.73 albertel 296: my @responselist;
1.74 albertel 297: my $type = $LONCAPA::CAPAresponse_args{'type'};
1.116 ! albertel 298: &LONCAPA_INTERNAL_DEBUG("Got type :$type:\n");
! 299: my $num_answers = scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}});
! 300: if ($type ne ''
! 301: && $num_answers > 1) {
1.104 albertel 302: (@responselist)=split(/,/,$response);
1.116 ! albertel 303: if (@responselist < $num_answers) {
1.105 albertel 304: return 'MISSING_ANSWER';
305: }
1.116 ! albertel 306: if (@responselist > $num_answers) {
1.105 albertel 307: return 'EXTRA_ANSWER';
308: }
1.73 albertel 309: } else {
310: (@responselist)=($response);
311: }
1.116 ! albertel 312: &LONCAPA_INTERNAL_DEBUG("Initial final response :$responselist['-1']:");
1.105 albertel 313: my $unit;
1.73 albertel 314: if ($type eq '' || $type eq 'float') {
315: #for numerical problems split off the unit
316: if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) {
317: $responselist['-1']=$1;
318: $unit=$2;
319: }
320: }
1.116 ! albertel 321: &LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:");
1.73 albertel 322: $unit=~s/\s//;
1.105 albertel 323:
1.116 ! albertel 324: #&reset_caparesponse_memoization();
! 325: my ($final_award,$final_msg);
! 326: &init_permutation(scalar(@responselist),
! 327: $LONCAPA::CAPAresponse_answer->{'type'});
! 328: while( &get_permutations_left() ) {
! 329: my @responses_ordered = @responselist[&get_next_permutation()];
! 330: my (@awards, @msgs, $i);
! 331: foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) {
! 332: my ($msg,$aresult);
! 333: if (defined($thisanswer)) {
! 334: my $response = $responses_ordered[$i];
! 335: if ($unit eq '') {
! 336: $response .= " $unit";
! 337: }
! 338: ($aresult,$msg)=&caparesponse_check($thisanswer,$response);
1.104 albertel 339: } else {
1.116 ! albertel 340: $aresult='ERROR';
! 341: $msg='answer was undefined';
1.104 albertel 342: }
1.116 ! albertel 343: #&LONCAPA_INTERNAL_DEBUG("after if $aresult -- $msg");
! 344: my ($temp)=split(/:/, $aresult);
! 345: push(@awards,$temp);
! 346: push(@msgs,$msg);
! 347: $i++;
! 348: }
! 349: my ($possible_award,$possible_msg) =
! 350: &LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs);
! 351: if ($final_award) {
! 352: ($final_award,$final_msg) =
! 353: &LONCAPA_INTERNAL_FINALIZEAWARDS([$final_award,$possible_award],
! 354: [$final_msg,$possible_msg],
! 355: undef,1);
1.73 albertel 356: } else {
1.116 ! albertel 357: ($final_award,$final_msg) = ($possible_award,$possible_msg);
1.73 albertel 358: }
359: }
1.116 ! albertel 360: #&reset_caparesponse_memoization();
! 361: return ($final_award,$final_msg);
1.7 albertel 362: }
363:
1.4 albertel 364: sub tex {
1.73 albertel 365: if ( $external::target eq "tex" ) {
366: return $_[0];
367: } else {
368: return $_[1];
369: }
1.4 albertel 370: }
371:
1.24 ng 372: sub var_in_tex {
1.73 albertel 373: if ( $external::target eq "tex" ) {
374: return $_[0];
375: } else {
376: return "";
377: }
1.24 ng 378: }
379:
1.4 albertel 380: sub web {
1.73 albertel 381: if ( $external::target eq "tex" ) {
382: return $_[1];
1.26 ng 383: } else {
1.73 albertel 384: if ( $external::target eq "web" || $external::target eq "answer") {
385: return $_[2];
386: } else {
387: return $_[0];
388: }
1.4 albertel 389: }
390: }
391:
1.24 ng 392: sub html {
1.73 albertel 393: if ( $external::target eq "web" ) {
394: return shift;
395: }
1.24 ng 396: }
397:
1.1 harris41 398: sub hinton {
1.73 albertel 399: return 0;
1.1 harris41 400: }
401:
402: sub random {
1.61 albertel 403: my ($start,$end,$step)=@_;
404: if ( ! $hidden::RANDOMINIT ) {
405: if ($external::randomseed == 0) { $external::randomseed=1; }
406: if ($external::randomseed =~/,/) {
1.84 albertel 407: my ($num1,$num2)=split(/,/,$external::randomseed);
408: &random_set_seed(1,abs($num1));
409: } elsif ($external::randomseed =~/:/) {
410: my ($num1,$num2)=split(/:/,$external::randomseed);
1.61 albertel 411: &random_set_seed(abs($num1),abs($num2));
412: } else {
413: &random_set_seed(1,int(abs($external::randomseed)));
414: }
415: &math_random_uniform();
416: $hidden::RANDOMINIT=1;
417: }
418: if (!defined($step)) { $step=1; }
419: my $num=1+int(($end-$start)/$step);
420: my $result=$start + int(&math_random_uniform() * $num)*$step;
421: return $result;
1.1 harris41 422: }
423:
1.26 ng 424: sub random_normal {
1.73 albertel 425: my ($item_cnt,$seed,$av,$std_dev) = @_;
426: my @oldseed=&random_get_seed();
427: my @retArray;
428: &random_set_seed_from_phrase($seed);
429: @retArray=&math_random_normal($item_cnt,$av,$std_dev);
430: &random_set_seed(@oldseed);
431: return @retArray;
1.26 ng 432: }
433:
434: sub random_beta {
1.73 albertel 435: my ($item_cnt,$seed,$aa,$bb) = @_;
436: my @oldseed=&random_get_seed();
437: my @retArray;
438: &random_set_seed_from_phrase($seed);
439: @retArray=&math_random_beta($item_cnt,$aa,$bb);
440: &random_set_seed(@oldseed);
441: return @retArray;
1.26 ng 442: }
443:
444: sub random_gamma {
1.73 albertel 445: my ($item_cnt,$seed,$a,$r) = @_;
446: my @oldseed=&random_get_seed();
447: my @retArray;
448: &random_set_seed_from_phrase($seed);
449: @retArray=&math_random_gamma($item_cnt,$a,$r);
450: &random_set_seed(@oldseed);
451: return @retArray;
1.26 ng 452: }
453:
454: sub random_exponential {
1.73 albertel 455: my ($item_cnt,$seed,$av) = @_;
456: my @oldseed=&random_get_seed();
457: my @retArray;
458: &random_set_seed_from_phrase($seed);
459: @retArray=&math_random_exponential($item_cnt,$av);
460: &random_set_seed(@oldseed);
461: return @retArray;
1.26 ng 462: }
463:
464: sub random_poisson {
1.73 albertel 465: my ($item_cnt,$seed,$mu) = @_;
466: my @oldseed=&random_get_seed();
467: my @retArray;
468: &random_set_seed_from_phrase($seed);
469: @retArray=&math_random_poisson($item_cnt,$mu);
470: &random_set_seed(@oldseed);
471: return @retArray;
1.26 ng 472: }
473:
474: sub random_chi {
1.73 albertel 475: my ($item_cnt,$seed,$df) = @_;
476: my @oldseed=&random_get_seed();
477: my @retArray;
478: &random_set_seed_from_phrase($seed);
479: @retArray=&math_random_chi_square($item_cnt,$df);
480: &random_set_seed(@oldseed);
481: return @retArray;
1.26 ng 482: }
483:
484: sub random_noncentral_chi {
1.73 albertel 485: my ($item_cnt,$seed,$df,$nonc) = @_;
486: my @oldseed=&random_get_seed();
487: my @retArray;
488: &random_set_seed_from_phrase($seed);
489: @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc);
490: &random_set_seed(@oldseed);
491: return @retArray;
1.26 ng 492: }
493:
494: sub random_f {
1.73 albertel 495: my ($item_cnt,$seed,$dfn,$dfd) = @_;
496: my @oldseed=&random_get_seed();
497: my @retArray;
498: &random_set_seed_from_phrase($seed);
499: @retArray=&math_random_f($item_cnt,$dfn,$dfd);
500: &random_set_seed(@oldseed);
501: return @retArray;
1.26 ng 502: }
503:
504: sub random_noncentral_f {
1.73 albertel 505: my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_;
506: my @oldseed=&random_get_seed();
507: my @retArray;
508: &random_set_seed_from_phrase($seed);
509: @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc);
510: &random_set_seed(@oldseed);
511: return @retArray;
1.26 ng 512: }
513:
514: sub random_multivariate_normal {
1.73 albertel 515: my ($item_cnt,$seed,$mean,$covar) = @_;
516: my @oldseed=&random_get_seed();
517: &random_set_seed_from_phrase($seed);
1.87 albertel 518: my @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar);
1.73 albertel 519: &random_set_seed(@oldseed);
520: return @retArray;
1.26 ng 521: }
522:
523: sub random_multinomial {
1.73 albertel 524: my ($item_cnt,$seed,@p) = @_;
525: my @oldseed=&random_get_seed();
526: my @retArray;
527: &random_set_seed_from_phrase($seed);
1.87 albertel 528: my @retArray=&math_random_multinomial($item_cnt,@p);
1.73 albertel 529: &random_set_seed(@oldseed);
530: return @retArray;
1.26 ng 531: }
532:
533: sub random_permutation {
1.73 albertel 534: my ($seed,@inArray) = @_;
535: my @oldseed=&random_get_seed();
536: my @retArray;
537: &random_set_seed_from_phrase($seed);
538: @retArray=&math_random_permutation(@inArray);
539: &random_set_seed(@oldseed);
540: return @retArray;
1.26 ng 541: }
542:
543: sub random_uniform {
1.73 albertel 544: my ($item_cnt,$seed,$low,$high) = @_;
545: my @oldseed=&random_get_seed();
546: my @retArray;
547: &random_set_seed_from_phrase($seed);
548: @retArray=&math_random_uniform($item_cnt,$low,$high);
549: &random_set_seed(@oldseed);
550: return @retArray;
1.26 ng 551: }
552:
553: sub random_uniform_integer {
1.73 albertel 554: my ($item_cnt,$seed,$low,$high) = @_;
555: my @oldseed=&random_get_seed();
556: my @retArray;
557: &random_set_seed_from_phrase($seed);
558: @retArray=&math_random_uniform_integer($item_cnt,$low,$high);
559: &random_set_seed(@oldseed);
560: return @retArray;
1.26 ng 561: }
562:
563: sub random_binomial {
1.73 albertel 564: my ($item_cnt,$seed,$nt,$p) = @_;
565: my @oldseed=&random_get_seed();
566: my @retArray;
567: &random_set_seed_from_phrase($seed);
568: @retArray=&math_random_binomial($item_cnt,$nt,$p);
569: &random_set_seed(@oldseed);
570: return @retArray;
1.26 ng 571: }
572:
573: sub random_negative_binomial {
1.73 albertel 574: my ($item_cnt,$seed,$ne,$p) = @_;
575: my @oldseed=&random_get_seed();
576: my @retArray;
577: &random_set_seed_from_phrase($seed);
578: @retArray=&math_random_negative_binomial($item_cnt,$ne,$p);
579: &random_set_seed(@oldseed);
580: return @retArray;
1.26 ng 581: }
582:
1.103 albertel 583: sub abs { CORE::abs(shift) }
584: sub sin { CORE::sin(shift) }
585: sub cos { CORE::cos(shift) }
586: sub exp { CORE::exp(shift) }
587: sub int { CORE::int(shift) }
588: sub log { CORE::log(shift) }
589: sub atan2 { CORE::atan2($_[0],$_[1]) }
590: sub sqrt { CORE::sqrt(shift) }
1.23 ng 591:
1.59 albertel 592: sub tan { CORE::sin($_[0]) / CORE::cos($_[0]) }
1.21 harris41 593: #sub atan { atan2($_[0], 1); }
594: #sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); }
595: #sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) ); }
1.22 ng 596:
1.59 albertel 597: sub log10 { CORE::log($_[0])/CORE::log(10); }
1.22 ng 598:
1.20 harris41 599: sub factorial {
1.59 albertel 600: my $input = CORE::int(shift);
1.20 harris41 601: return "Error - unable to take factorial of an negative number ($input)" if $input < 0;
602: return "Error - factorial result is greater than system limit ($input)" if $input > 170;
603: return 1 if $input == 0;
604: my $result = 1;
605: for (my $i=2; $i<=$input; $i++) { $result *= $i }
606: return $result;
607: }
608:
609: sub sgn {
610: return -1 if $_[0] < 0;
611: return 0 if $_[0] == 0;
612: return 1 if $_[0] > 0;
613: }
614:
615: sub min {
616: my @sorted = sort { $a <=> $b || $a cmp $b } @_;
617: return shift @sorted;
618: }
619:
620: sub max {
621: my @sorted = sort { $a <=> $b || $a cmp $b } @_;
622: return pop @sorted;
623: }
1.1 harris41 624:
1.20 harris41 625: sub roundto {
626: my ($input,$n) = @_;
627: return sprintf('%.'.$n.'f',$input);
628: }
629:
630: sub to_string {
631: my ($input,$n) = @_;
1.26 ng 632: return sprintf($input) if $n eq "";
633: $n = '.'.$n if $n !~ /^\./;
1.20 harris41 634: return sprintf('%'.$n,$input) if $n ne "";
635: }
636:
637: sub sub_string {
638: my ($str,$start,$len) = @_;
639: return substr($str,$start-1,$len);
640: }
1.1 harris41 641:
642: sub pow {return $_[0] ** $_[1]; }
1.59 albertel 643: sub ceil {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? (CORE::int($_[0])+ 1) : CORE::int($_[0])); }
644: sub floor {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? CORE::int($_[0]) : (CORE::int($_[0])-1)); }
1.27 ng 645: #sub floor {return int($_[0]); }
1.1 harris41 646:
1.2 albertel 647: sub format {
1.73 albertel 648: my ($value,$fmt)=@_;
1.81 albertel 649: my ($dollarmode,$commamode,$alwaysperiod,$options);
650: if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; }
651: #if ($options =~ /\$/) { $dollamode=1; }
652: #if ($options =~ /,/) { $commamode=1; }
1.82 albertel 653: if ($options =~ /\./) { $alwaysperiod=1; }
1.99 ng 654: my $result;
1.97 albertel 655: if ($fmt=~/s$/i) {
656: $result=&format_significant_figures($value,$fmt);
657: } else {
658: $fmt=~s/e/E/g;
1.99 ng 659: $result=sprintf('%.'.$fmt,$value);
1.97 albertel 660: if ($alwaysperiod && $fmt eq '0f') { $result .='.'; }
661: $result=~s/(E[+-]*)0/$1/;
662: }
1.81 albertel 663: #if ($dollarmode) {$result=&dollarformat($result);}
664: #if ($commamode) {$result=&commaformat($result);}
1.73 albertel 665: return $result;
1.46 albertel 666: }
667:
1.75 albertel 668: sub chemparse {
669: my ($reaction) = @_;
1.96 albertel 670: my @tokens = split(/(\s\+|\->|<=>|<\-|\.)/,$reaction);
1.75 albertel 671: my $formula = '';
672: foreach my $token (@tokens) {
673: if ($token eq '->' ) {
674: $formula .= '<m>\ensuremath{\rightarrow}</m> ';
675: next;
676: }
1.96 albertel 677: if ($token eq '<-' ) {
678: $formula .= '<m>\ensuremath{\leftarrow}</m> ';
679: next;
680: }
1.75 albertel 681: if ($token eq '<=>') {
682: if ($external::target eq 'web' &&
683: &EXT('request.browser.unicode')) {
1.76 albertel 684: $formula .= '⇌ ';
1.75 albertel 685: } else {
686: $formula .= &web('<=> ','<m>\ensuremath{\rightleftharpoons}</m> ',
1.95 albertel 687: '<=> ');
1.75 albertel 688: }
689: next;
690: }
1.96 albertel 691: if ($token eq '.') {
692: $formula =~ s/(\ \;| )$//;
693: $formula .= '·';
694: next;
695: }
696: $token =~ /^\s*([\d|\/]*(?:&frac\d\d)?)(.*)/;
1.90 albertel 697: $formula .= $1 if ($1 ne '1'); # stoichiometric coefficient
1.75 albertel 698:
699: my $molecule = $2;
700: # subscripts
1.78 albertel 701: $molecule =~ s|(?<=[a-zA-Z\)\]\s])(\d+)|<sub>$1</sub>|g;
1.75 albertel 702: # superscripts
703: $molecule =~ s|\^(\d*[+\-]*)|<sup>$1</sup>|g;
704: # strip whitespace
705: $molecule =~ s/\s*//g;
706: # forced space
707: $molecule =~ s/_/ /g;
1.96 albertel 708: $molecule =~ s/-/−/g;
1.75 albertel 709: $formula .= $molecule.' ';
710: }
711: # get rid of trailing space
1.87 albertel 712: $formula =~ s/(\ \;| )$//;
1.75 albertel 713: return &xmlparse($formula);
714: }
715:
1.46 albertel 716: sub prettyprint {
1.73 albertel 717: my ($value,$fmt,$target)=@_;
718: my $result;
719: if (!$target) { $target = $external::target; }
1.75 albertel 720: if ($fmt =~ /chem/i) { return(&chemparse($value)); }
1.81 albertel 721: my ($dollarmode,$commamode,$alwaysperiod,$options);
722: if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; }
1.86 albertel 723: if ($options =~ /\$/) { $dollarmode=1; }
1.81 albertel 724: if ($options =~ /,/) { $commamode=1; }
725: if ($options =~ /\./) { $alwaysperiod=1; }
1.97 albertel 726: if ($fmt=~/s$/i) {
727: $value=&format_significant_figures($value,$fmt);
728: } elsif ($fmt) {
729: $value=sprintf('%.'.$fmt,$value);
730: }
1.81 albertel 731: if ($alwaysperiod && $fmt eq '0f') {
732: if ($target eq 'tex') {
733: $value .='\\ensuremath{.}';
734: } else {
735: $value .='.';
736: }
737: }
1.73 albertel 738: if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/i ) {
739: my $frac=$1;
740: if ($dollarmode) { $frac=&dollarformat($frac); }
1.80 albertel 741: if ($commamode) { $frac=&commaformat($frac); }
1.73 albertel 742: my $exponent=$2;
743: $exponent=~s/^\+0*//;
744: $exponent=~s/^-0*/-/;
745: $exponent=~s/^-0*/-/;
746: if ($exponent eq '-') { undef($exponent); }
747: if ($exponent) {
748: if ($target eq 'web') {
749: $result=$frac.'×10<sup>'.$exponent.'</sup>';
750: } elsif ($target eq 'tex') {
751: $result='\ensuremath{'.$frac.'\times 10^{'.$exponent.'}}';
752: } else {
753: $result=$value;
754: }
755: } else {
756: $result=$frac;
757: }
758: } else {
1.48 albertel 759: $result=$value;
1.86 albertel 760: if ($dollarmode) { $result=&dollarformat($result,$target); }
761: elsif ($commamode) { $result=&commaformat($result,$target); }
1.46 albertel 762: }
1.73 albertel 763: return $result;
1.48 albertel 764: }
765:
1.80 albertel 766: sub commaformat {
1.73 albertel 767: my ($number,$target) = @_;
768: if ($number =~ /\./) {
1.102 albertel 769: while ($number =~ /([^0-9]*)([0-9]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) {
770: $number = $1.$2.','.$3.$4;
1.73 albertel 771: }
772: } else {
1.102 albertel 773: while ($number =~ /^([^0-9]*)([0-9]+)([^,][^,][^,])([,0-9]*)$/) {
774: $number = $1.$2.','.$3.$4;
1.73 albertel 775: }
776: }
1.80 albertel 777: return $number;
778: }
779:
780: sub dollarformat {
781: my ($number,$target) = @_;
782: if (!$target) { $target = $external::target; }
783: $number=&commaformat($number,$target);
1.73 albertel 784: if ($target eq 'tex') {
785: $number='\$'.$number; #' stupid emacs
786: } else {
787: $number='$'.$number; #' stupid emacs
788: }
789: return $number;
1.2 albertel 790: }
1.5 albertel 791:
1.97 albertel 792: # format of form ns or nS where n is an integer
793: sub format_significant_figures {
794: my ($number,$format) = @_;
795: return '0' if ($number == 0);
796: # extract number of significant figures needed
797: my ($sig) = ($format =~ /(\d+)s/i);
798: # arbitrary choice - suggestions ?? or throw error message?
799: $sig = 3 if ($sig eq '');
800: # save the minus sign
801: my $sign = ($number < 0) ? '-' : '';
802: $number = abs($number);
803: # needed to correct for a number greater than 1 (or
804: my $power = ($number < 1) ? 0 : 1;
805: # could round up. Take the integer part of log10.
806: my $x10 = int(log($number)/log(10));
807: # find number with values left of decimal pt = # of sign figs.
808: my $xsig = $number*10**($sig-$x10-$power);
809: # get just digits left of decimal pt - also rounds off correctly
810: my $xint = sprintf('%.0f',$xsig);
811: # save any trailing zero's
812: my ($zeros) = ($xint =~ /(0+)$/);
813: # return number to original magnitude
814: my $numSig = $xint*10**($x10-$sig+$power);
815: # insert trailing zero's if have decimal point
816: $numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/;
1.98 albertel 817: # put a decimal pt for number ending with 0 and length = # of sig fig
818: $numSig.='.' if (length($numSig) == $sig && $numSig =~ /0$/);
819: if (length($numSig) < $sig) {
820: $numSig.='.'.substr($zeros,0,($sig-length($numSig)));
821: }
1.97 albertel 822: # return number with sign
823: return $sign.$numSig;
824:
825: }
826:
1.5 albertel 827: sub map {
1.27 ng 828: my ($phrase,$dest,$source)=@_;
1.51 albertel 829: my @oldseed=&random_get_seed();
1.27 ng 830: my @seed = &random_seed_from_phrase($phrase);
831: &random_set_seed(@seed);
832: my $destct = scalar(@$dest);
1.28 ng 833: if (!$source) {
834: my @output;
835: my @idx = &math_random_permuted_index($destct);
836: my $ctr = 0;
837: while ($ctr < $destct) {
838: $output[$ctr] = $$dest[$idx[$ctr]];
1.27 ng 839: $ctr++;
1.28 ng 840: }
1.51 albertel 841: &random_set_seed(@oldseed);
1.28 ng 842: return @output;
1.27 ng 843: } else {
1.28 ng 844: my $num = scalar(@$source);
845: my @idx = &math_random_permuted_index($num);
846: my $ctr = 0;
847: my $tot = $num;
848: $tot = $destct if $destct < $num;
849: if (ref($$dest[0])) {
850: while ($ctr < $tot) {
851: ${$$dest[$ctr]} = $$source[$idx[$ctr]];
852: $ctr++;
853: }
854: } else {
855: while ($ctr < $tot) {
856: $$dest[$ctr] = $$source[$idx[$ctr]];
857: $ctr++;
858: }
859: }
1.27 ng 860: }
1.56 albertel 861: &random_set_seed(@oldseed);
1.51 albertel 862: return '';
1.27 ng 863: }
864:
865: sub rmap {
866: my ($phrase,$dest,$source)=@_;
1.51 albertel 867: my @oldseed=&random_get_seed();
1.27 ng 868: my @seed = &random_seed_from_phrase($phrase);
869: &random_set_seed(@seed);
870: my $destct = scalar(@$dest);
1.28 ng 871: if (!$source) {
872: my @idx = &math_random_permuted_index($destct);
873: my $ctr = 0;
874: my @r_idx;
875: while ($ctr < $destct) {
876: $r_idx[$idx[$ctr]] = $ctr;
877: $ctr++;
878: }
879: my @output;
880: $ctr = 0;
881: while ($ctr < $destct) {
882: $output[$ctr] = $$dest[$r_idx[$ctr]];
1.27 ng 883: $ctr++;
1.28 ng 884: }
1.51 albertel 885: &random_set_seed(@oldseed);
1.28 ng 886: return @output;
1.27 ng 887: } else {
1.28 ng 888: my $num = scalar(@$source);
889: my @idx = &math_random_permuted_index($num);
890: my $ctr = 0;
891: my $tot = $num;
892: $tot = $destct if $destct < $num;
893: my @r_idx;
1.27 ng 894: while ($ctr < $tot) {
1.28 ng 895: $r_idx[$idx[$ctr]] = $ctr;
1.27 ng 896: $ctr++;
1.28 ng 897: }
898: $ctr = 0;
899: if (ref($$dest[0])) {
900: while ($ctr < $tot) {
901: ${$$dest[$ctr]} = $$source[$r_idx[$ctr]];
902: $ctr++;
903: }
904: } else {
905: while ($ctr < $tot) {
906: $$dest[$ctr] = $$source[$r_idx[$ctr]];
907: $ctr++;
908: }
909: }
1.6 albertel 910: }
1.51 albertel 911: &random_set_seed(@oldseed);
912: return '';
1.5 albertel 913: }
1.22 ng 914:
1.23 ng 915: sub capa_id { return }
916:
917: sub problem { return }
918:
1.22 ng 919: sub name{
1.73 albertel 920: my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename');
921: $fullname = "" if $fullname eq ", ";
922: $fullname =~ s/\%2d/-/g;
923: return $fullname;
1.22 ng 924: }
925:
926: sub student_number {
1.73 albertel 927: my $id = &EXT('environment.id');
928: $id = '' if $id eq "";
929: return $id;
1.22 ng 930: }
931:
932: sub class {
1.73 albertel 933: my $course = &EXT('course.description');
934: $course = '' if $course eq "";
935: return $course;
1.22 ng 936: }
937:
1.112 www 938: sub firstname {
939: my $firstname = &EXT('environment.firstname');
940: $firstname = '' if $firstname eq "";
941: return $firstname;
942: }
943:
944: sub lastname {
945: my $lastname = &EXT('environment.lastname');
946: $lastname = '' if $lastname eq "";
947: return $lastname;
948: }
949:
1.22 ng 950: sub sec {
1.73 albertel 951: my $sec = &EXT('request.course.sec');
952: $sec = '' if $sec eq "";
953: return $sec;
1.22 ng 954: }
955:
1.23 ng 956: sub open_date {
1.73 albertel 957: my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate')));
958: return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
959: my @hm = split(/:/,$dc[3]);
960: my $ampm = " am";
961: if ($hm[0] > 12) {
962: $hm[0]-=12;
963: $ampm = " pm";
964: }
965: return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
1.23 ng 966: }
967:
968: sub due_date {
1.73 albertel 969: my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate')));
970: return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
971: my @hm = split(/:/,$dc[3]);
972: my $ampm = " am";
973: if ($hm[0] > 12) {
974: $hm[0]-=12;
975: $ampm = " pm";
976: }
977: return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
1.23 ng 978: }
979:
980: sub answer_date {
1.73 albertel 981: my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate')));
982: return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
983: my @hm = split(/:/,$dc[3]);
984: my $ampm = " am";
985: if ($hm[0] > 12) {
986: $hm[0]-=12;
987: $ampm = " pm";
988: }
989: return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
1.24 ng 990: }
991:
992: sub array_moments {
1.73 albertel 993: my @input=@_;
994: my (@output,$N);
995: $N=scalar (@input);
996: $output[0]=$N;
997: if ($N <= 1) {
998: $output[1]=$input[0];
999: $output[1]="Input array not defined" if ($N == 0);
1000: $output[2]="variance undefined for N<=1";
1001: $output[3]="skewness undefined for N<=1";
1002: $output[4]="kurtosis undefined for N<=1";
1003: return @output;
1004: }
1005: my $sum=0;
1006: foreach my $line (@input) {
1007: $sum+=$line;
1008: }
1009: $output[1] = $sum/$N;
1010: my ($x,$sdev,$var,$skew,$kurt) = 0;
1011: foreach my $line (@input) {
1012: $x=$line-$output[1];
1013: $var+=$x**2;
1014: $skew+=$x**3;
1015: $kurt+=$x**4;
1016: }
1017: $output[2]=$var/($N-1);
1018: $sdev=CORE::sqrt($output[2]);
1019: if ($sdev == 0) {
1020: $output[3]="inf-variance=0";
1021: $output[4]="inf-variance=0";
1022: return @output;
1023: }
1024: $output[3]=$skew/($sdev**3*$N);
1025: $output[4]=$kurt/($sdev**4*$N)-3;
1.24 ng 1026: return @output;
1027: }
1.5 albertel 1028:
1029: sub choose {
1.73 albertel 1030: my $num = $_[0];
1031: return $_[$num];
1.5 albertel 1032: }
1.23 ng 1033:
1.101 albertel 1034: #&sum1(1,$x,sub { &sum1($_[0],2*$_[0], sub { fact($_[0])**2 })});
1035: #sub sum1 {
1036: # my ($start,$end,$sub)=@_;
1037: # my $sum=0;
1038: # for (my $i=$start;$i<=$end;$i++) {
1039: # $sum+=&$sub($i);
1040: # }
1041: # return $sum
1042: #}
1043:
1044: #&sum2('a',1,$x,'&sum2(\'b\',$a,2*$a, \'&factorial($b)**2\')');
1045: #sub sum2 {
1046: # my ($varname,$start,$end,$line)=@_;
1047: # my $sum=0;
1048: # for (my $i=$start;$i<=$end;$i++) {
1049: # my $func=sub {
1050: # eval("\$".$varname."=$i");
1051: # eval($line);
1052: # };
1053: # $sum+=&$func($i);
1054: # }
1055: # return $sum
1056: #}
1057:
1.49 albertel 1058: # expiremental idea
1059: sub proper_path {
1.73 albertel 1060: my ($path)=@_;
1061: if ( $external::target eq "tex" ) {
1062: return '/home/httpd/html'.$path;
1063: } else {
1064: return $path;
1065: }
1.49 albertel 1066: }
1.23 ng 1067:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to default_homework.lcpm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework