![[BACK]](/icons/back.gif){kind=icon}
Return to lonspreadsheet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface|
Return to lonspreadsheet.pm CVS log | Up to [LON-CAPA] / loncom / interface |
1.1 www 1: # The LearningOnline Network with CAPA
2: # Spreadsheet/Grades Display Handler
3: #
1.2 ! www 4: # 11/11,11/15,11/27 Gerd Kortemeyer
1.1 www 5:
6: package Apache::lonspreadsheet;
7:
8: use strict;
9: use Safe;
10: use Opcode;
11: use vars qw(%v %t %f);
12: use Apache::lonnet;
13: use Apache::Constants qw(:common);
14:
15: sub deffunc {
16: my $safeeval=shift;
17: my $code=<<'ENDDEFS';
18: # ---------------------------------------------------- Inside of the safe space
19:
20: sub mask {
21: my ($lower,$upper)=@_;
22:
23: $lower=~/([A-Z]|\*)(\d+|\*)/;
24: my $la=$1;
25: my $ld=$2;
26:
27: $upper=~/([A-Z]|\*)(\d+|\*)/;
28: my $ua=$1;
29: my $ud=$2;
30: my $alpha='';
31: my $num='';
32:
33: if (($la eq '*') || ($ua eq '*')) {
34: $alpha='[A-Z]';
35: } else {
36: $alpha='['.$la.'-'.$ua.']';
37: }
38:
39: if (($ld eq '*') || ($ud eq '*')) {
40: $num='\d+';
41: } else {
42: if (length($ld)!=length($ud)) {
43: $num.='(';
44: map {
45: $num.='['.$_.'-9]';
46: } ($ld=~m/\d/g);
47: if (length($ud)-length($ld)>1) {
48: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
49: }
50: $num.='|';
51: map {
52: $num.='[0-'.$_.']';
53: } ($ud=~m/\d/g);
54: $num.=')';
55: } else {
56: my @lda=($ld=~m/\d/g);
57: my @uda=($ud=~m/\d/g);
58: my $i; $j=0;
59: for ($i=0;$i<=$#lda;$i++) {
60: if ($lda[$i]==$uda[$i]) {
61: $num.=$lda[$i];
62: $j=$i;
63: }
64: }
65: if ($j<$#lda-1) {
66: $num.='('.$lda[$j+1];
67: for ($i=$j+2;$i<=$#lda;$i++) {
68: $num.='['.$lda[$i].'-9]';
69: }
70: if ($uda[$j+1]-$lda[$j+1]>1) {
71: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
72: ($#lda-$j-1).'}';
73: }
74: $num.='|'.$uda[$j+1];
75: for ($i=$j+2;$i<=$#uda;$i++) {
76: $num.='[0-'.$uda[$i].']';
77: }
78: $num.=')';
79: } else {
80: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
81: }
82: }
83: }
84: return '^'.$alpha.$num.'$';
85: }
86:
87:
88: sub NUM {
89: my $mask=mask(@_);
90: my $num=0;
91: map {
92: $num++;
93: } grep /$mask/,keys %v;
94: return $num;
95: }
96:
97: sub BIN {
98: my ($low,$high,$lower,$upper)=@_;
99: my $mask=mask($lower,$upper);
100: my $num=0;
101: map {
102: if (($v{$_}>=$low) && ($v{$_}<=$high)) {
103: $num++;
104: }
105: } grep /$mask/,keys %v;
106: return $num;
107: }
108:
109:
110: sub SUM {
111: my $mask=mask(@_);
112: my $sum=0;
113: map {
114: $sum+=$v{$_};
115: } grep /$mask/,keys %v;
116: return $sum;
117: }
118:
119: sub MEAN {
120: my $mask=mask(@_);
121: my $sum=0; my $num=0;
122: map {
123: $sum+=$v{$_};
124: $num++;
125: } grep /$mask/,keys %v;
126: if ($num) {
127: return $sum/$num;
128: } else {
129: return undef;
130: }
131: }
132:
133: sub STDDEV {
134: my $mask=mask(@_);
135: my $sum=0; my $num=0;
136: map {
137: $sum+=$v{$_};
138: $num++;
139: } grep /$mask/,keys %v;
140: unless ($num>1) { return undef; }
141: my $mean=$sum/$num;
142: $sum=0;
143: map {
144: $sum+=($v{$_}-$mean)**2;
145: } grep /$mask/,keys %v;
146: return sqrt($sum/($num-1));
147: }
148:
149: sub PROD {
150: my $mask=mask(@_);
151: my $prod=1;
152: map {
153: $prod*=$v{$_};
154: } grep /$mask/,keys %v;
155: return $prod;
156: }
157:
158: sub MAX {
159: my $mask=mask(@_);
160: my $max='-';
161: map {
162: unless ($max) { $max=$v{$_}; }
163: if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
164: } grep /$mask/,keys %v;
165: return $max;
166: }
167:
168: sub MIN {
169: my $mask=mask(@_);
170: my $min='-';
171: map {
172: unless ($max) { $max=$v{$_}; }
173: if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
174: } grep /$mask/,keys %v;
175: return $min;
176: }
177:
178: sub SUMMAX {
179: my ($num,$lower,$upper)=@_;
180: my $mask=mask($lower,$upper);
181: my @inside=();
182: map {
183: $inside[$#inside+1]=$v{$_};
184: } grep /$mask/,keys %v;
185: @inside=sort(@inside);
186: my $sum=0; my $i;
187: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
188: $sum+=$inside[$i];
189: }
190: return $sum;
191: }
192:
193: sub SUMMIN {
194: my ($num,$lower,$upper)=@_;
195: my $mask=mask($lower,$upper);
196: my @inside=();
197: map {
198: $inside[$#inside+1]=$v{$_};
199: } grep /$mask/,keys %v;
200: @inside=sort(@inside);
201: my $sum=0; my $i;
202: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
203: $sum+=$inside[$i];
204: }
205: return $sum;
206: }
207:
208:
209: # ------------------------------------------- End of "Inside of the safe space"
210: ENDDEFS
211: $safeeval->reval($code);
212: }
213:
214: sub sett {
215: %t=();
216: map {
217: if ($f{$_}) {
218: $t{$_}=$f{$_};
219: $t{$_}=~s/\.+/\,/g;
220: $t{$_}=~s/(^|[^\"\'])([A-Z]\d+)/$1\$v\{\'$2\'\}/g;
221: }
222: } keys %f;
223: }
224:
225: sub calcv {
226: my $safeeval=shift;
227: %v=();
228: my $notfinished=1;
229: my $depth=0;
230: while ($notfinished) {
231: $notfinished=0;
232: map {
233: my $old=$v{$_};
234: $v{$_}=$safeeval->reval($t{$_});
235: if ($@) {
236: %v=();
237: return $@;
238: }
239: if ($v{$_} ne $old) { $notfinished=1; }
240: } keys %t;
241: $depth++;
242: if ($depth>100) {
243: %v=();
244: return 'Maximum calculation depth exceeded';
245: }
246: }
247: return '';
248: }
249:
250: sub handler {
251: %v=();
252: %t=();
253: %f=();
254: my $safeeval = new Safe;
1.2 ! www 255: my $safehole = new Safe::Hole;
1.1 www 256: $safeeval->permit("entereval");
257: $safeeval->permit(":base_math");
258: $safeeval->permit("sort");
259: $safeeval->deny(":base_io");
1.2 ! www 260: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
1.1 www 261: $safeeval->share('%v','%t','%f');
262: &deffunc($safeeval);
263: $f{'A3'}=5;
264: $f{'A4'}=3;
265: $f{'A5'}=8;
266: $f{'E100'}=5;
267: $f{'C3'}='A3+6';
268: $f{'B4'}='8+int(C3/3)';
269: $f{'C7'}='A3+B4';
270: $f{'G8'}='MEAN("E*")';
271: $f{'G5'}='A3+SUMMIN(2,"A*")';
272: $f{'G6'}='A3+SUM("A*")';
273: $f{'G7'}='STDDEV("A*")';
274: $f{'G9'}='NUM("G*")';
275: $f{'H10'}='MEAN("E*")';
276: $f{'G10'}='BIN(3,5,"A*")';
277: &sett();
278: print &calcv($safeeval)."\n";
279: print $v{'C7'}."\n";
280: print $t{'G5'}.' - '.$v{'G5'}."\n";
281: print $t{'G6'}.' - '.$v{'G6'}."\n";
282: print $t{'G7'}.' - '.$v{'G7'}."\n";
283: print $t{'G8'}.' - '.$v{'G8'}."\n";
284: print $t{'G9'}.' - '.$v{'G9'}."\n";
285: print $t{'G10'}.' - '.$v{'G10'}."\n";
286: }
287:
288: 1;
289: __END__
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305: