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.116 2006/09/29 20:55:33 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:
30: #init some globals
31: $hidden::RANDOMINIT=0;
32: $pi=atan2(1,1)*4;
33: $rad2deg=180.0/$pi;
34: $deg2rad=$pi/180.0;
35: $"=' ';
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: }
102:
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:
129: sub caparesponse_check {
130: my ($answer,$response)=@_;
131: #not properly used yet: calc
132: #not to be used: $ans_fmt
133: my $type=$LONCAPA::CAPAresponse_args{'type'};
134: my $tol=$LONCAPA::CAPAresponse_args{'tol'};
135: my $sig=$LONCAPA::CAPAresponse_args{'sig'};
136: my $ans_fmt=$LONCAPA::CAPAresponse_args{'format'};
137: my $unit=$LONCAPA::CAPAresponse_args{'unit'};
138: my $calc=$LONCAPA::CAPAresponse_args{'calc'};
139: my $samples=$LONCAPA::CAPAresponse_args{'samples'};
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
147:
148: #remove leading and trailing whitespace
149: if (!defined($response)) {
150: $response='';
151: }
152: if ($response=~ /^\s|\s$/) {
153: $response=~ s:^\s+|\s+$::g;
154: &LONCAPA_INTENAL_DEBUG("Removed ws now :$response:");
155: }
156:
157: &LONCAPA_INTERNAL_DEBUG(" type is $type ");
158: if ($type eq 'cs' || $type eq 'ci') {
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;
163: } elsif ($type eq 'mc') {
164: $answer=~s/[\s,]//g;
165: $response=~s/[\s,]//g;
166: }
167: if ($type eq 'float' && $unit=~/\$/) {
168: if ($response!~/^\$/) { return "NO_UNIT: Missing \$ "; }
169: $response=~s/\$//g;
170: }
171: if ($type eq 'float' && $unit=~/\,/ && (&check_commas($response)<0)) {
172: return "COMMA_FAIL:";
173: }
174: $ans_fmt=~s/\W//g;
175: $unit=~s/[\$,]//g;
176: if ($type eq 'float') { $response=~s/,//g; }
177:
178: if (length($response) > 500) { return "TOO_LONG: Answer too long"; }
179:
180: if ($type eq '' ) {
181: &LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting");
182: if ( $answer eq ($answer *1.0)) { $type = 2;
183: } else { $type = 3; }
184: } else {
185: if ($type eq 'cs') { $type = 4; }
186: elsif ($type eq 'ci') { $type = 3 }
187: elsif ($type eq 'mc') { $type = 5; }
188: elsif ($type eq 'fml') { $type = 8; }
189: elsif ($type eq 'math') { $type = 9; }
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);
201: &LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples");
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:
215: ($sig_ubound,$sig_lbound)=&LONCAPA_INTERNAL_get_sigrange($sig);
216:
217: my $reterror="";
218: my $result;
219: if ($type eq '9') {
220: $result = &maxima_check(&maxima_cas_formula_fix($response),&maxima_cas_formula_fix($answer),\$reterror);
221: } else {
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,
227: $tol_type,$tol,
228: $sig_lbound,$sig_ubound,
229: $ans_fmt,$unit,$calc,$id_list,
230: $points,$external::randomseed,
231: \$reterror);
232: }
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'; }
244: elsif ($result =='12' && !$response) { $result='MISSING_ANSWER'; }
245: elsif ($result =='12') { $result='WANTED_NUMERIC'; }
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'; }
251: else {$result = "ERROR: Unknown Result:$result:$@:";}
252:
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)
255: }
256:
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)=@_;
269: # Escape scientific notation, so 3e8 does not become 3*e*8
270: # 3e8 -> 3&8; 3e-8 -> 3&-8; 3E+8 -> e&+8
271: $expression=~s/(\d+)e([\+\-]*\d+)/$1\&\($2\)/gsi;
272: # 3x10^8 -> 3&8; 3*10^-8 -> 3&-8
273: $expression=~s/(\d+)(?:x|\*)10(?:\^|\*\*)([\+\-]*\d+)/$1\&\($2\)/gsi;
274: # Fill in multiplication signs
275: # a b -> a*b;3 b -> 3*b;3 4 -> 3*4
276: $expression=~s/(\w)\s+(\w)/$1\*$2/gs;
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;
283: # a3 -> a*3;
284: $expression=~s/([a-zA-Z])(\d)/$1\*$2/gs;
285: # )a -> )*a; )3 -> )*3; ) 3 -> )*3
286: $expression=~s/\)\s*(\w)/\)\*$1/gs;
287: # 3&8 -> 3e8; 3&-4 -> 3e-4
288: $expression=~s/(\d+)\&\(([\+\-]*\d+)\)/$1e$2/gs;
289: return $expression;
290: }
291:
292: sub caparesponse_check_list {
293: my $response=$LONCAPA::CAPAresponse_args{'response'};
294: my $result="Got response :".join(':',@LONCAPA::CAPAresponse_answer).":\n";
295: &LONCAPA_INTERNAL_DEBUG("args ".join(':',%LONCAPA::CAPAresponse_args));
296: my @responselist;
297: my $type = $LONCAPA::CAPAresponse_args{'type'};
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) {
302: (@responselist)=split(/,/,$response);
303: if (@responselist < $num_answers) {
304: return 'MISSING_ANSWER';
305: }
306: if (@responselist > $num_answers) {
307: return 'EXTRA_ANSWER';
308: }
309: } else {
310: (@responselist)=($response);
311: }
312: &LONCAPA_INTERNAL_DEBUG("Initial final response :$responselist['-1']:");
313: my $unit;
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: }
321: &LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:");
322: $unit=~s/\s//;
323:
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);
339: } else {
340: $aresult='ERROR';
341: $msg='answer was undefined';
342: }
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);
356: } else {
357: ($final_award,$final_msg) = ($possible_award,$possible_msg);
358: }
359: }
360: #&reset_caparesponse_memoization();
361: return ($final_award,$final_msg);
362: }
363:
364: sub tex {
365: if ( $external::target eq "tex" ) {
366: return $_[0];
367: } else {
368: return $_[1];
369: }
370: }
371:
372: sub var_in_tex {
373: if ( $external::target eq "tex" ) {
374: return $_[0];
375: } else {
376: return "";
377: }
378: }
379:
380: sub web {
381: if ( $external::target eq "tex" ) {
382: return $_[1];
383: } else {
384: if ( $external::target eq "web" || $external::target eq "answer") {
385: return $_[2];
386: } else {
387: return $_[0];
388: }
389: }
390: }
391:
392: sub html {
393: if ( $external::target eq "web" ) {
394: return shift;
395: }
396: }
397:
398: sub hinton {
399: return 0;
400: }
401:
402: sub random {
403: my ($start,$end,$step)=@_;
404: if ( ! $hidden::RANDOMINIT ) {
405: if ($external::randomseed == 0) { $external::randomseed=1; }
406: if ($external::randomseed =~/,/) {
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);
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;
422: }
423:
424: sub random_normal {
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;
432: }
433:
434: sub random_beta {
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;
442: }
443:
444: sub random_gamma {
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;
452: }
453:
454: sub random_exponential {
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;
462: }
463:
464: sub random_poisson {
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;
472: }
473:
474: sub random_chi {
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;
482: }
483:
484: sub random_noncentral_chi {
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;
492: }
493:
494: sub random_f {
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;
502: }
503:
504: sub random_noncentral_f {
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;
512: }
513:
514: sub random_multivariate_normal {
515: my ($item_cnt,$seed,$mean,$covar) = @_;
516: my @oldseed=&random_get_seed();
517: &random_set_seed_from_phrase($seed);
518: my @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar);
519: &random_set_seed(@oldseed);
520: return @retArray;
521: }
522:
523: sub random_multinomial {
524: my ($item_cnt,$seed,@p) = @_;
525: my @oldseed=&random_get_seed();
526: my @retArray;
527: &random_set_seed_from_phrase($seed);
528: my @retArray=&math_random_multinomial($item_cnt,@p);
529: &random_set_seed(@oldseed);
530: return @retArray;
531: }
532:
533: sub random_permutation {
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;
541: }
542:
543: sub random_uniform {
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;
551: }
552:
553: sub random_uniform_integer {
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;
561: }
562:
563: sub random_binomial {
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;
571: }
572:
573: sub random_negative_binomial {
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;
581: }
582:
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) }
591:
592: sub tan { CORE::sin($_[0]) / CORE::cos($_[0]) }
593: #sub atan { atan2($_[0], 1); }
594: #sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); }
595: #sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) ); }
596:
597: sub log10 { CORE::log($_[0])/CORE::log(10); }
598:
599: sub factorial {
600: my $input = CORE::int(shift);
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: }
624:
625: sub roundto {
626: my ($input,$n) = @_;
627: return sprintf('%.'.$n.'f',$input);
628: }
629:
630: sub to_string {
631: my ($input,$n) = @_;
632: return sprintf($input) if $n eq "";
633: $n = '.'.$n if $n !~ /^\./;
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: }
641:
642: sub pow {return $_[0] ** $_[1]; }
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)); }
645: #sub floor {return int($_[0]); }
646:
647: sub format {
648: my ($value,$fmt)=@_;
649: my ($dollarmode,$commamode,$alwaysperiod,$options);
650: if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; }
651: #if ($options =~ /\$/) { $dollamode=1; }
652: #if ($options =~ /,/) { $commamode=1; }
653: if ($options =~ /\./) { $alwaysperiod=1; }
654: my $result;
655: if ($fmt=~/s$/i) {
656: $result=&format_significant_figures($value,$fmt);
657: } else {
658: $fmt=~s/e/E/g;
659: $result=sprintf('%.'.$fmt,$value);
660: if ($alwaysperiod && $fmt eq '0f') { $result .='.'; }
661: $result=~s/(E[+-]*)0/$1/;
662: }
663: #if ($dollarmode) {$result=&dollarformat($result);}
664: #if ($commamode) {$result=&commaformat($result);}
665: return $result;
666: }
667:
668: sub chemparse {
669: my ($reaction) = @_;
670: my @tokens = split(/(\s\+|\->|<=>|<\-|\.)/,$reaction);
671: my $formula = '';
672: foreach my $token (@tokens) {
673: if ($token eq '->' ) {
674: $formula .= '<m>\ensuremath{\rightarrow}</m> ';
675: next;
676: }
677: if ($token eq '<-' ) {
678: $formula .= '<m>\ensuremath{\leftarrow}</m> ';
679: next;
680: }
681: if ($token eq '<=>') {
682: if ($external::target eq 'web' &&
683: &EXT('request.browser.unicode')) {
684: $formula .= '⇌ ';
685: } else {
686: $formula .= &web('<=> ','<m>\ensuremath{\rightleftharpoons}</m> ',
687: '<=> ');
688: }
689: next;
690: }
691: if ($token eq '.') {
692: $formula =~ s/(\ \;| )$//;
693: $formula .= '·';
694: next;
695: }
696: $token =~ /^\s*([\d|\/]*(?:&frac\d\d)?)(.*)/;
697: $formula .= $1 if ($1 ne '1'); # stoichiometric coefficient
698:
699: my $molecule = $2;
700: # subscripts
701: $molecule =~ s|(?<=[a-zA-Z\)\]\s])(\d+)|<sub>$1</sub>|g;
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;
708: $molecule =~ s/-/−/g;
709: $formula .= $molecule.' ';
710: }
711: # get rid of trailing space
712: $formula =~ s/(\ \;| )$//;
713: return &xmlparse($formula);
714: }
715:
716: sub prettyprint {
717: my ($value,$fmt,$target)=@_;
718: my $result;
719: if (!$target) { $target = $external::target; }
720: if ($fmt =~ /chem/i) { return(&chemparse($value)); }
721: my ($dollarmode,$commamode,$alwaysperiod,$options);
722: if ($fmt =~ /^([^\d]*)(.*)/) { $options=$1; $fmt=$2; }
723: if ($options =~ /\$/) { $dollarmode=1; }
724: if ($options =~ /,/) { $commamode=1; }
725: if ($options =~ /\./) { $alwaysperiod=1; }
726: if ($fmt=~/s$/i) {
727: $value=&format_significant_figures($value,$fmt);
728: } elsif ($fmt) {
729: $value=sprintf('%.'.$fmt,$value);
730: }
731: if ($alwaysperiod && $fmt eq '0f') {
732: if ($target eq 'tex') {
733: $value .='\\ensuremath{.}';
734: } else {
735: $value .='.';
736: }
737: }
738: if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/i ) {
739: my $frac=$1;
740: if ($dollarmode) { $frac=&dollarformat($frac); }
741: if ($commamode) { $frac=&commaformat($frac); }
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 {
759: $result=$value;
760: if ($dollarmode) { $result=&dollarformat($result,$target); }
761: elsif ($commamode) { $result=&commaformat($result,$target); }
762: }
763: return $result;
764: }
765:
766: sub commaformat {
767: my ($number,$target) = @_;
768: if ($number =~ /\./) {
769: while ($number =~ /([^0-9]*)([0-9]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) {
770: $number = $1.$2.','.$3.$4;
771: }
772: } else {
773: while ($number =~ /^([^0-9]*)([0-9]+)([^,][^,][^,])([,0-9]*)$/) {
774: $number = $1.$2.','.$3.$4;
775: }
776: }
777: return $number;
778: }
779:
780: sub dollarformat {
781: my ($number,$target) = @_;
782: if (!$target) { $target = $external::target; }
783: $number=&commaformat($number,$target);
784: if ($target eq 'tex') {
785: $number='\$'.$number; #' stupid emacs
786: } else {
787: $number='$'.$number; #' stupid emacs
788: }
789: return $number;
790: }
791:
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/;
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: }
822: # return number with sign
823: return $sign.$numSig;
824:
825: }
826:
827: sub map {
828: my ($phrase,$dest,$source)=@_;
829: my @oldseed=&random_get_seed();
830: my @seed = &random_seed_from_phrase($phrase);
831: &random_set_seed(@seed);
832: my $destct = scalar(@$dest);
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]];
839: $ctr++;
840: }
841: &random_set_seed(@oldseed);
842: return @output;
843: } else {
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: }
860: }
861: &random_set_seed(@oldseed);
862: return '';
863: }
864:
865: sub rmap {
866: my ($phrase,$dest,$source)=@_;
867: my @oldseed=&random_get_seed();
868: my @seed = &random_seed_from_phrase($phrase);
869: &random_set_seed(@seed);
870: my $destct = scalar(@$dest);
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]];
883: $ctr++;
884: }
885: &random_set_seed(@oldseed);
886: return @output;
887: } else {
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;
894: while ($ctr < $tot) {
895: $r_idx[$idx[$ctr]] = $ctr;
896: $ctr++;
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: }
910: }
911: &random_set_seed(@oldseed);
912: return '';
913: }
914:
915: sub capa_id { return }
916:
917: sub problem { return }
918:
919: sub name{
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;
924: }
925:
926: sub student_number {
927: my $id = &EXT('environment.id');
928: $id = '' if $id eq "";
929: return $id;
930: }
931:
932: sub class {
933: my $course = &EXT('course.description');
934: $course = '' if $course eq "";
935: return $course;
936: }
937:
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:
950: sub sec {
951: my $sec = &EXT('request.course.sec');
952: $sec = '' if $sec eq "";
953: return $sec;
954: }
955:
956: sub open_date {
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;
966: }
967:
968: sub due_date {
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;
978: }
979:
980: sub answer_date {
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;
990: }
991:
992: sub array_moments {
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;
1026: return @output;
1027: }
1028:
1029: sub choose {
1030: my $num = $_[0];
1031: return $_[$num];
1032: }
1033:
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:
1058: # expiremental idea
1059: sub proper_path {
1060: my ($path)=@_;
1061: if ( $external::target eq "tex" ) {
1062: return '/home/httpd/html'.$path;
1063: } else {
1064: return $path;
1065: }
1066: }
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