Annotation of loncom/interface/lonspreadsheet.pm, revision 1.1
1.1 ! www 1: # The LearningOnline Network with CAPA
! 2: # Spreadsheet/Grades Display Handler
! 3: #
! 4: # 11/11,11/15 Gerd Kortemeyer
! 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;
! 255: $safeeval->permit("entereval");
! 256: $safeeval->permit(":base_math");
! 257: $safeeval->permit("sort");
! 258: $safeeval->deny(":base_io");
! 259: # $safeeval->share_from('Apache::lonnet',['&EXT']);
! 260: $safeeval->share('%v','%t','%f');
! 261: &deffunc($safeeval);
! 262: $f{'A3'}=5;
! 263: $f{'A4'}=3;
! 264: $f{'A5'}=8;
! 265: $f{'E100'}=5;
! 266: $f{'C3'}='A3+6';
! 267: $f{'B4'}='8+int(C3/3)';
! 268: $f{'C7'}='A3+B4';
! 269: $f{'G8'}='MEAN("E*")';
! 270: $f{'G5'}='A3+SUMMIN(2,"A*")';
! 271: $f{'G6'}='A3+SUM("A*")';
! 272: $f{'G7'}='STDDEV("A*")';
! 273: $f{'G9'}='NUM("G*")';
! 274: $f{'H10'}='MEAN("E*")';
! 275: $f{'G10'}='BIN(3,5,"A*")';
! 276: &sett();
! 277: print &calcv($safeeval)."\n";
! 278: print $v{'C7'}."\n";
! 279: print $t{'G5'}.' - '.$v{'G5'}."\n";
! 280: print $t{'G6'}.' - '.$v{'G6'}."\n";
! 281: print $t{'G7'}.' - '.$v{'G7'}."\n";
! 282: print $t{'G8'}.' - '.$v{'G8'}."\n";
! 283: print $t{'G9'}.' - '.$v{'G9'}."\n";
! 284: print $t{'G10'}.' - '.$v{'G10'}."\n";
! 285: }
! 286:
! 287: 1;
! 288: __END__
! 289:
! 290:
! 291:
! 292:
! 293:
! 294:
! 295:
! 296:
! 297:
! 298:
! 299:
! 300:
! 301:
! 302:
! 303:
! 304:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[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