File:  [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.1: download - view: text, annotated - select for diffs
Wed Nov 15 10:37:27 2000 UTC (23 years, 7 months ago) by www
Branches: MAIN
CVS tags: HEAD
Spreadsheet/Grades Viewer

    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>