Annotation of loncom/interface/lonstatistics.pm, revision 1.26

1.1       albertel    1: # The LearningOnline Network with CAPA
                      2: # (Publication Handler
                      3: #
1.26    ! minaeibi    4: # $Id: lonstatistics.pm,v 1.25 2002/05/31 13:47:01 minaeibi Exp $
1.1       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: #
                     28: # (Navigate problems for statistical reports
                     29: # YEAR=2001
1.15      minaeibi   30: # 5/5,7/9,7/25/1,8/11,9/13,9/26,10/5,10/9,10/22,10/26 Behrouz Minaei
1.14      minaeibi   31: # 11/1,11/4,11/16,12/14,12/16,12/18,12/20,12/31 Behrouz Minaei
1.1       albertel   32: # YEAR=2002
1.18      minaeibi   33: # 1/22,2/1,2/6,2/25,3/2,3/6,3/17,3/21,3/22,3/26,4/7,5/6 Behrouz Minaei
1.21      minaeibi   34: # 5/12,5/14,5/15,5/19,5/26 Behrouz Minaei
1.14      minaeibi   35: #
1.1       albertel   36: ###
                     37: 
1.3       minaeibi   38: package Apache::lonstatistics; 
1.1       albertel   39: 
1.15      minaeibi   40: use strict; 
1.1       albertel   41: use Apache::Constants qw(:common :http);
                     42: use Apache::lonnet();
                     43: use Apache::lonhomework;
1.12      minaeibi   44: use Apache::loncommon;
1.1       albertel   45: use HTML::TokeParser;
                     46: use GDBM_File;
                     47: 
                     48: # -------------------------------------------------------------- Module Globals
                     49: my %hash;
                     50: my %CachData;
                     51: my %GraphDat;
1.12      minaeibi   52: my %OpResp;
1.1       albertel   53: my %maps;
1.5       minaeibi   54: my %mapsort;
1.1       albertel   55: my %section;
                     56: my %StuBox;
                     57: my %DiscFac;
1.7       minaeibi   58: my %DisUp;
                     59: my %DisLow;
                     60: my $UpCnt;
1.1       albertel   61: my $CurMap;
                     62: my $CurSec;
                     63: my $CurStu;
                     64: my @cols;
                     65: my @list;
                     66: my @students;
                     67: my $p_count;
                     68: my $Pos;
                     69: my $r;
                     70: my $OpSel1;
                     71: my $OpSel2;
                     72: my $OpSel3;
                     73: my $OpSel4;
                     74: my $GData;
                     75: my $cid;
                     76: my $firstres;
                     77: my $lastres;
1.5       minaeibi   78: my $DiscFlag;
                     79: my $HWN;
                     80: my $P_Order;
1.25      minaeibi   81: my %color;
1.15      minaeibi   82: my %foil_to_concept;
                     83: my @Concepts;
                     84: my %ConceptData;
1.6       minaeibi   85: my %Header = (0,"Homework Sets Order",1,"#Stdnts",2,"Tries",3,"Mod",
1.5       minaeibi   86:               4,"Mean",5,"#YES",6,"#yes",7,"%Wrng",8,"DoDiff",
1.15      minaeibi   87:               9,"S.D.",10,"Skew.",11,"D.F.1st",12,"D.F.2nd");
1.18      minaeibi   88: my %Answer = ();
1.15      minaeibi   89: 
1.21      minaeibi   90: 
                     91: sub Activity {
1.26    ! minaeibi   92:     my $file="/home/minaeibi/activity.log";
        !            93:     my $userid='adamsde1';
1.21      minaeibi   94:     $r->print("<br>Using $file");
                     95:     $r->rflush();
                     96:     open(FILEID, "<$file");
                     97:     my $line;
                     98:     my @allaccess;
1.25      minaeibi   99:     my $Count=0;
1.21      minaeibi  100:     while ($line=<FILEID>) {
                    101: 	my ($time,$machine,$what)=split(':',$line);
1.25      minaeibi  102: 	$what=&Apache::lonnet::unescape($what);
1.21      minaeibi  103: 	my @accesses=split('&',$what);
                    104: 	foreach my $access (@accesses) {
                    105: 	    my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
                    106: 	    if ($who ne $userid) { next; }
1.25      minaeibi  107: 	    if (!$resource) { next; }
                    108: 	    my $res=&Apache::lonnet::unescape($resource);
1.26    ! minaeibi  109: 	    if (($res =~ /\.(problem|htm|html)/)) {
1.25      minaeibi  110: 		$Count++;
1.26    ! minaeibi  111: 		$r->print("<br>$Count) ".localtime($date).": $who --> $res");
        !           112: #	        if ($post) { 
        !           113: #		    $Count++;
        !           114: #		    $r->print("<br><b>$Count) Sent data ".join(':',
        !           115: #                              &Apache::lonnet::unescape(@posts)).'</b>');
        !           116: #		}
1.25      minaeibi  117: 		$r->rflush();
1.26    ! minaeibi  118: 	    }
1.25      minaeibi  119: 	##    push (@allaccess,unescape($access));
1.21      minaeibi  120: 	    #print $machine;
                    121: 	}
                    122:     }
1.25      minaeibi  123: #    @allaccess=sort(@allaccess);
                    124: #    $Count=0;
                    125: #    foreach my $access (@allaccess) {
                    126: #	my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
                    127: #	$Count++;
                    128: #	$r->print("<br>$Count) $date: $who --> $resource");
                    129: #	$r->rflush();
                    130: #	if ($post) { 
                    131: #	    $r->print("<br><b>Sent data ".join(':',unescape(@posts)).'</b>');
                    132: #	}
                    133: #    }
1.21      minaeibi  134: }
                    135: 
                    136: 
                    137: 
1.15      minaeibi  138: sub InitAnalysis {
                    139:     my ($rid, $student)=@_;
                    140:     my ($uname,$udom)=split(/\:/,$student);
                    141:     $rid=~/(\d+)\.(\d+)/;
                    142:     my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.
                    143: 	     &Apache::lonnet::declutter($hash{'src_'.$rid});
                    144:     my $URI = $hash{'src_'.$rid};
                    145:     my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze',
                    146:                                   'grade_username' => $uname,
                    147:                                   'grade_domain' => $udom,
                    148:                                   'grade_courseid' => $cid,
                    149:                                   'grade_symb' => $symb));
                    150: #    my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze'));
                    151: 
                    152:     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
1.18      minaeibi  153:     %Answer=();
1.15      minaeibi  154:     %Answer=&Apache::lonnet::str2hash($Answ);
                    155: 
                    156:     my $parts='';
                    157:     foreach my $elm (@{$Answer{"parts"}}) {
                    158: 	$parts.="$elm,";
                    159:     }
                    160:     chop($parts);
                    161:     my $conc='';
                    162:     foreach my $elm (@{$Answer{"$parts.concepts"}}) {
                    163: 	$conc.="$elm@";
                    164:     }
                    165:     chop($conc);
                    166: 
                    167:     @Concepts=split(/\@/,$conc);
                    168:     foreach my $concept (@{$Answer{"$parts.concepts"}}) {
                    169: 	foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
                    170: 	    $foil_to_concept{$foil} = $concept;
1.19      minaeibi  171: 	    #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
1.15      minaeibi  172: 	}
                    173:     }
                    174:     return $symb;
                    175: }
                    176: 
                    177: 
                    178: sub Interval {
1.16      minaeibi  179:     my ($rid,$part,$symb)=@_;
1.15      minaeibi  180:     my $Int=$ConceptData{"Interval"};
1.16      minaeibi  181:     my $due = &Apache::lonnet::EXT('resource.$part.duedate',$symb)+1;
                    182:     my $opn = &Apache::lonnet::EXT('resource.$part.opendate',$symb);
1.15      minaeibi  183:     my $add=int(($due-$opn)/$Int);
                    184:     $ConceptData{"Int.0"}=$opn;
                    185:     for (my $i=1;$i<$Int;$i++) {
                    186: 	$ConceptData{"Int.$i"}=$opn+$i*$add;
                    187:     }
                    188:     $ConceptData{"Int.$Int"}=$due;     
                    189:     for (my $i=0;$i<$Int;$i++) {
                    190: 	for (my $n=0; $n<=$#Concepts; $n++ ) {
                    191: 	    my $tmp=$Concepts[$n];
                    192: 	    $ConceptData{"$tmp.$i.true"}=0;
                    193: 	    $ConceptData{"$tmp.$i.false"}=0;
                    194: 	}
                    195:     }
                    196: }
                    197: 
                    198: 
                    199: sub ShowOpGraph {
                    200:     my ($InpStr, $Int_No)=@_;
1.16      minaeibi  201:     my ($rid,$part)=split(/\:/,substr($InpStr,8));
1.15      minaeibi  202:     $ConceptData{"Interval"}=$Int_No;
1.19      minaeibi  203:     #Initialize the option response true answers
1.16      minaeibi  204:     my $symb=&InitAnalysis($rid,$students[0]);
1.19      minaeibi  205:     #compute the intervals
1.16      minaeibi  206:     &Interval($rid,$part,$symb);
1.15      minaeibi  207:     my $URI = $hash{'src_'.$rid};
                    208:     my $Src = $hash{'title_'.$rid};
                    209:     $Src =~ s/\ /"_"/eg;
                    210:     $r->print('<br><b>'.$URI.'</b>');
                    211:     $r->rflush();
                    212:     
1.19      minaeibi  213:     #Java script Progress window
1.16      minaeibi  214:     &Create_PrgWin();
                    215:     &Update_PrgWin("Starting to analyze problem");
1.15      minaeibi  216:     for (my $index=0;$index<=$#students;$index++) {
                    217: 	&Update_PrgWin($index);
                    218: 	&OpStatus($rid,$students[$index]);
                    219:     }
                    220:     &Close_PrgWin();
                    221: 
1.19      minaeibi  222:     $r->print('<br>');
1.15      minaeibi  223:     for (my $k=0; $k<$Int_No; $k++ ) {
1.18      minaeibi  224: 	&DrawGraph($k,$Src);
1.15      minaeibi  225:     }
1.20      minaeibi  226:     for (my $k=0; $k<$Int_No; $k++ ) {
                    227: 	&DrawTable($k);
                    228:     }
1.17      minaeibi  229: #$Apache::lonxml::debug=1;
                    230: #&Apache::lonhomework::showhash(%ConceptData);
                    231: #$Apache::lonxml::debug=0;
1.15      minaeibi  232:     my $Answ=&Apache::lonnet::ssi($URI);
                    233:     $r->print("<br><b>Here you can see the Problem:</b><br>$Answ");
                    234: }
                    235: 
1.18      minaeibi  236: 
1.20      minaeibi  237: sub DrawTable {
                    238:     my $k=shift;
1.15      minaeibi  239:     my $Max=0;
                    240:     my @data1;
                    241:     my @data2;
1.18      minaeibi  242:     my $Correct=0;
                    243:     my $Wrong=0;
1.15      minaeibi  244:     for (my $n=0; $n<=$#Concepts; $n++ ) {
                    245: 	my $tmp=$Concepts[$n];
                    246: 	$data1[$n]=$ConceptData{"$tmp.$k.true"};
1.18      minaeibi  247: 	$Correct+=$data1[$n];
1.15      minaeibi  248: 	$data2[$n]=$ConceptData{"$tmp.$k.false"};
1.18      minaeibi  249: 	$Wrong+=$data2[$n];
1.15      minaeibi  250: 	my $Sum=$data1[$n]+$data2[$n];
                    251: 	if ( $Max<$Sum ) {$Max=$Sum;}
                    252:     }
                    253:     for (my $n=0; $n<=$#Concepts; $n++ ) {
                    254: 	if ($data1[$n]+$data2[$n]<$Max) {
                    255: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
                    256: 	}
                    257:     }
1.18      minaeibi  258:     my $P_No = $#data1+1;
                    259: #    $r->print('<br><b>From: ['.localtime($ConceptData{'Int.'.($k-1)}).
                    260: #              '] To: ['.localtime($ConceptData{"Int.$k"}).']</b>'); 
                    261:     my $Str = "\n".'<table border=2>'.
                    262:               "\n".'<tr>'.
                    263:               "\n".'<th> # </th>'.
                    264: 	      "\n".'<th> Concept </th>'.
                    265: 	      "\n".'<th> Correct </th>'.
                    266: 	      "\n".'<th> Wrong </th>'.
                    267: 	      "\n".'</tr>';
1.15      minaeibi  268: 
1.18      minaeibi  269:     for (my $n=0; $n<=$#Concepts; $n++ ) {
                    270: 	$Str .= "\n"."<tr>".
                    271: 	        "\n"."<td>".($n+1)."</td>".
1.25      minaeibi  272:                 "\n".'<td bgcolor='.$color{"yellow"}.'> '.$Concepts[$n]." </td>".
                    273:                 "\n".'<td bgcolor='.$color{"green"}.'> '.$data1[$n]." </td>".
                    274:                 "\n".'<td bgcolor='.$color{"red"}.'> '.$data2[$n]." </td>".
1.18      minaeibi  275:                 "\n"."</tr>";
                    276:     }
1.20      minaeibi  277:     $Str.='<td></td><td><b>From:['.localtime($ConceptData{'Int.'.$k}).
                    278:           '] To: ['.localtime($ConceptData{'Int.'.($k+1)}-1).
                    279:           "]</b></td><td>$Correct</td><td>$Wrong</td>";
                    280: 
                    281:     $Str .= "\n".'</table>';
                    282: 
                    283:     $r->print($Str);
1.19      minaeibi  284: #$Apache::lonxml::debug=1;
                    285: #&Apache::lonhomework::showhash(%ConceptData);
                    286: #$Apache::lonxml::debug=0;
1.20      minaeibi  287: }
1.19      minaeibi  288: 
1.15      minaeibi  289: 
1.20      minaeibi  290: sub DrawGraph {
                    291:     my ($k,$Src)=@_;
                    292:     my $Max=0;
                    293:     my @data1;
                    294:     my @data2;
1.15      minaeibi  295: 
1.20      minaeibi  296:     # Adjust Data and find the Max 
                    297:     for (my $n=0; $n<=$#Concepts; $n++ ) {
                    298: 	my $tmp=$Concepts[$n];
                    299: 	$data1[$n]=$ConceptData{"$tmp.$k.true"};
                    300: 	$data2[$n]=$ConceptData{"$tmp.$k.false"};
                    301: 	my $Sum=$data1[$n]+$data2[$n];
                    302: 	if ( $Max<$Sum ) {$Max=$Sum;}
                    303:     }
                    304:     for (my $n=0; $n<=$#Concepts; $n++ ) {
                    305: 	if ($data1[$n]+$data2[$n]<$Max) {
                    306: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
                    307: 	}
                    308:     }
                    309:     my $P_No = $#data1+1;
1.18      minaeibi  310: 
                    311:     if ( $Max > 1 ) { 
                    312: 	$Max += (10 - $Max % 10);
                    313: 	$Max = int($Max);
                    314:     } else { $Max = 1; }
                    315: 
1.19      minaeibi  316:     my $Titr=($ConceptData{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
1.18      minaeibi  317: #    $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
                    318:     $GData="$Titr&Concepts&Answers&$Max&$P_No&".
                    319:            (join(',',@data1)).'&'.(join(',',@data2));
                    320: 
1.19      minaeibi  321:     $r->print('<IMG src="/cgi-bin/graph.gif?'.$GData.'" border=1/>');
1.15      minaeibi  322: }
                    323: 
                    324: 
                    325: sub AnalyzeProblem {
1.19      minaeibi  326:     # selecting the number of intervals
1.15      minaeibi  327:     my $OpSel='';
                    328:     my $CurInt = $ENV{'form.interval'};
                    329:     if ($CurInt eq '') {$CurMap = '1';}
1.21      minaeibi  330:     my $Ptr = '<br><b>Select number of intervals</b>'."\n".
1.15      minaeibi  331:        	      '<select name="interval">'."\n";                     	     	     
                    332:     for (my $n=1;$n<=7;$n++) {	          
                    333: 	$Ptr .= '<option';
                    334:         if ($CurInt eq $n) {$Ptr .= ' selected';}     
                    335: 	$Ptr .= '>'.$n."</option>"."\n";	     
                    336:     }
                    337:     $Ptr .= '</select>'."\n";
                    338:     $r->print( $Ptr );
                    339: 
1.19      minaeibi  340:     #the table of option response problems
1.15      minaeibi  341:     $r->print('<br><b> Option Response Problems in this course:</b><br><br>');
                    342:     my $Str = "\n".'<table border=2>'.
                    343:               "\n".'<tr>'.
                    344:               "\n".'<th> # </th>'.
                    345: 	      "\n".'<th> Problem Title </th>'.
1.21      minaeibi  346: 	      "\n".'<th> Resource </th>'.
1.15      minaeibi  347: 	      "\n".'<th> Address </th>'.
                    348: 	      "\n".'</tr>';
                    349: 
                    350:      my $P_No=1;
                    351:      foreach (sort keys %OpResp) {
1.16      minaeibi  352: 	 my ($rid,$part)=split(/\:/,$OpResp{$_});
                    353: 	 my $Temp = '<a href="'.$hash{'src_'.$rid}.
                    354:                     '" target="_blank">'.$hash{'title_'.$rid}.'</a>';
1.15      minaeibi  355: 	 $Str .= "\n"."<tr>".
                    356: 	         "\n"."<td> $P_No </td>".
1.25      minaeibi  357:                  "\n"."<td bgcolor=".$color{"green"}."> ".$Temp." </td>".
                    358:                  "\n"."<td bgcolor=".$color{"yellow"}."> ".$hash{'src_'.$rid}." </td>".
1.16      minaeibi  359: 	         "\n"."<td> ".'<input type="submit" name="sort" value="'.'Analyze_'.$rid.'" />'.'</td>'.
1.15      minaeibi  360:                  "\n"."</tr>";
                    361: 	 $P_No++;
                    362:      }
                    363:      $Str .= "\n".'</table>';
                    364:      $Str .= "\n".'</form>';
                    365:      $r->print($Str);
                    366:      $r->rflush();	
                    367: }
                    368: 
                    369: 
                    370: sub Decide {
1.19      minaeibi  371:     #deciding the true or false answer belongs to each interval
1.15      minaeibi  372:     my ($type,$foil,$time)=@_; 
                    373:     my $k=0;
                    374:     while ($time>$ConceptData{'Int.'.($k+1)} && 
                    375:            $k<$ConceptData{'Interval'}) {$k++;}
                    376:     $ConceptData{"$foil_to_concept{$foil}.$k.$type"}++;
                    377: }
                    378: 
                    379: 
1.19      minaeibi  380: #restore the student submissions and finding the result
1.15      minaeibi  381: sub OpStatus {
                    382:     my ($rid,$student)=@_;
                    383:     my ($uname,$udom)=split(/\:/,$student);
                    384:     my $code='U';
                    385:     $rid=~/(\d+)\.(\d+)/;
                    386:     my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.
                    387: 	     &Apache::lonnet::declutter($hash{'src_'.$rid});
                    388:     my %reshash=&Apache::lonnet::restore($symb,$cid,$udom,$uname);
                    389:     my @True = ();
                    390:     my @False = ();
                    391:     my $flag=0;
                    392:     if ($reshash{'version'}) {
1.18      minaeibi  393:         my $tries=0;
                    394: 	&Apache::lonhomework::showhash(%Answer);
1.15      minaeibi  395: 	for (my $version=1;$version<=$reshash{'version'};$version++) {
                    396: 	    my $time=$reshash{"$version:timestamp"};
1.18      minaeibi  397: 	   
                    398: 	    foreach my $key (sort(split(/\:/,$reshash{$version.':keys'}))) {
                    399: 		if (($key=~/\.(\w+)\.(\w+)\.submission$/)) {
                    400: 		    my $Id1 = $1; my $Id2 = $2;
                    401: 		    #check if this is a repeat submission, if so skip it
                    402:           	    if ($reshash{"$version:resource.$Id1.previous"}) { next; }
                    403: 		    #if no solved this wasn't a real submission, ignore it
                    404: 		    if (!defined($reshash{"$version:resource.$Id1.solved"})) {
                    405: 			&Apache::lonxml::debug("skipping ");
                    406: 			next;
                    407: 		    }
                    408: 		    my $Resp = $reshash{"$version:$key"};
1.15      minaeibi  409: 		    my %submission=&Apache::lonnet::str2hash($Resp);
                    410: 		    foreach (keys %submission) {
1.18      minaeibi  411: 			my $Ansr = $Answer{"$Id1.$Id2.foil.value.$_"};
1.15      minaeibi  412: 			if ($submission{$_}) {
                    413: 			    if ($submission{$_} eq $Ansr) {
                    414: 				&Decide("true",$_,$time );
                    415: 			    }
                    416: 			    else {&Decide("false",$_,$time );}
                    417: 			}
                    418: 		    }
                    419: 	        }	  
                    420: 	    }
                    421:         }
                    422:     }
                    423: }
1.11      minaeibi  424: 
                    425: 
1.7       minaeibi  426: #------- Processing upperlist and lowerlist according to each problem
                    427: sub ProcessDisc {
                    428:     my @List = @_;
                    429:     @List = sort (@List);
                    430:     my $Count = $#List+1;
                    431:     my $Prb;
                    432:     my @Dis;
                    433:     my $Slvd=0;
                    434:     my $tmp;
1.8       minaeibi  435:     my $Sum1=0;
                    436:     my $Sum2=0;
1.7       minaeibi  437:     my $nIdx=0;
                    438:     my $nStud=0;
                    439:     my %Proc;
                    440:     undef %Proc;
                    441:     while ($nIdx<$Count) {
                    442: 	($Prb,$tmp)=split(/\=/,$List[$nIdx]);
                    443: 	@Dis=split(/\+/,$tmp);
                    444: 	my $Temp = $Prb;
                    445: 	do {
                    446: 	    $nIdx++;
                    447: 	    $nStud++;
1.8       minaeibi  448: 	    $Sum1 += $Dis[0];
                    449: 	    $Sum2 += $Dis[1];
1.7       minaeibi  450: 	    ($Prb,$tmp)=split(/\=/,$List[$nIdx]);
                    451: 	    @Dis=split(/\+/,$tmp);
                    452: 	} while ( $Prb eq $Temp && $nIdx < $Count );
1.8       minaeibi  453: #	$Proc{$Temp}=($Sum1/$nStud).':'.$nStud;
                    454: 	$Proc{$Temp}=($Sum1/$nStud).':'.($Sum2/$nStud);
1.15      minaeibi  455: #       $r->print("$nIdx) $Temp --> ($nStud) $Proc{$Temp} <br>");
1.8       minaeibi  456: 	$Sum1=0;
                    457: 	$Sum2=0;
1.7       minaeibi  458: 	$nStud=0;
                    459:     }
                    460:     return %Proc;
                    461: }
                    462: 
                    463: 
                    464: #------- Creating Discimination factor   
                    465: sub Discriminant {
                    466:     my $Count=0;
                    467:     foreach (keys(%DiscFac)){ 
                    468: 	$Count++;
                    469:     }
                    470:     $UpCnt = int(0.27*$Count);
                    471:     my $low=0;
                    472:     my $up=$Count-$UpCnt;
                    473:     my @UpList=();
                    474:     my @LowList=();
                    475:     $Count=0;
                    476:     foreach my $key (sort(keys(%DiscFac))){ 
                    477: 	$Count++;    
                    478:         #$r->print("<br>$Count) $key = $DiscFac{$key}");
                    479: 	if ($low < $UpCnt || $Count > $up) {
                    480: 	    $low++;
                    481: 	    my $str=$DiscFac{$key};
                    482: 	    foreach(split(/\:/,$str)){
                    483: 		if ($_) {
                    484: 		    if ($low<$UpCnt){push(@LowList,$_);}
                    485: 		    else {push(@UpList,$_);}
                    486: 		}
                    487: 	    }
                    488: 	}
                    489:     }
                    490:     %DisUp=&ProcessDisc(@UpList);
                    491:     %DisLow=&ProcessDisc(@LowList);
                    492: }
                    493: 
                    494:    
1.1       albertel  495: sub NumericSort {          
                    496:     $a <=> $b;
                    497: }
                    498: 
                    499: # ------ Create different Student Report 
                    500: sub StudentReport {
                    501:     my ($sname,$sdom)=@_;
                    502:     if ( $sname eq 'All Students' ) {
                    503: 	$r->print( '<h3><font color=blue>WARNING: 
                    504:                     Please select a student</font></h3>' );
                    505: 	return;
                    506:     }
1.14      minaeibi  507:     my %result = &Apache::lonnet::dump($cid,$sdom,$sname);
1.1       albertel  508:     my $ResId;
1.5       minaeibi  509:     my $PrOrd;
1.1       albertel  510:     my $Code;
                    511:     my $Tries;
                    512:     my $TotalTries = 0;
                    513:     my $ParCr = 0;
                    514:     my $Wrongs;
                    515:     my %TempHash;
                    516:     my $Version;
                    517:     my $LatestVersion;
                    518:     my $PtrTry='';
                    519:     my $PtrCod='';
                    520:     my $SetNo=0;
                    521:     my $Str = "\n".'<table border=2>'.
                    522:               "\n".'<tr>'.
                    523:               "\n".'<th> # </th>'.
                    524: 	      "\n".'<th> Set Title </th>'.
                    525: 	      "\n".'<th> Results </th>'.
                    526: 	      "\n".'<th> Tries </th>'.
                    527: 	      "\n".'</tr>';
1.14      minaeibi  528:     my ($temp)=keys(%result);
1.23      stredwic  529:     unless ($temp=~/^(con_lost|error|no_such_host)/i) {
1.5       minaeibi  530:         foreach my $CurCol (@cols) {
                    531: 	    if (!$CurCol){
1.1       albertel  532: 		my $Set=&Apache::lonnet::declutter($hash{'map_id_'.$1});
                    533: 		if ( $Set ) {
                    534: 		    $SetNo++;
                    535: 		    $Str .= "\n"."<tr>".
                    536: 			    "\n"."<td> $SetNo </td>".
                    537:                             "\n"."<td> $Set </td>".
                    538:                             "\n"."<td> $PtrCod </td>".
                    539:                             "\n"."<td> $PtrTry</td>".
                    540:                             "\n"."</tr>";
                    541: 		}
                    542: 		$PtrTry='';
                    543: 		$PtrCod='';
                    544: 		next; 
                    545: 	    }
1.5       minaeibi  546: 	    ($PrOrd,$ResId)=split(/\:/,$CurCol);
1.1       albertel  547:             $ResId=~/(\d+)\.(\d+)/;
                    548:             my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
                    549:             if ( $CurMap ne 'All Maps' ) {
                    550: 		my ( $ResMap, $NameMap ) = split(/\=/,$CurMap);
                    551: 		if ( $Map ne $ResMap ) { next; }
                    552: 	    }
                    553: 	    my $meta=$hash{'src_'.$ResId};
                    554: 	    my $PartNo = 0;
                    555: 	    undef %TempHash;
1.5       minaeibi  556: 	    foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))){
1.12      minaeibi  557: 		if ($_=~/^stores\_(\w+)\_tries$/) {
1.1       albertel  558:                     my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
                    559: 		    if ( $TempHash{"$Part"} eq '' ) { 
                    560: 			$TempHash{"$Part"} = $Part;
                    561: 			$TempHash{$PartNo}=$Part;
                    562: 			$TempHash{"$Part.Code"} = '-';  
1.5       minaeibi  563: 			$TempHash{"$Part.PrOrd"} = $PrOrd+$PartNo;  
1.1       albertel  564: 			$PartNo++;
                    565: 		    }
                    566: 		}
1.5       minaeibi  567:             }
1.1       albertel  568: 
                    569:             my $Prob = $Map.'___'.$2.'___'.
                    570:                        &Apache::lonnet::declutter( $hash{'src_'.$ResId} );
                    571:             $Code='U';
                    572:             $Tries = 0;
                    573:             $Wrongs = 0;
1.7       minaeibi  574:   	    $LatestVersion = $result{"version:$Prob"};
1.1       albertel  575: 	    if ( $LatestVersion ) {
                    576: 		for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
                    577: 		    my $vkeys = $result{"$Version:keys:$Prob"};
                    578: 		    my @keys = split(/\:/,$vkeys);		
                    579:   
                    580: 		    foreach my $Key (@keys) {		  
                    581: 			if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
                    582: 			    my $Part = $1;
                    583: 			    $Tries = $result{"$Version:$Prob:resource.$Part.tries"};
                    584: 			    $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0; 
                    585: 			    $TotalTries += $Tries;
                    586: 			    my $Val = $result{"$Version:$Prob:resource.$Part.solved"};
                    587: 			    if ( $Val eq 'correct_by_student' )
                    588:                                 { $Wrongs = $Tries - 1; $Code = 'Y'; } 
                    589: 			    elsif ( $Val eq 'correct_by_override' )
                    590:                                 { $Wrongs = $Tries - 1; $Code = 'y'; }                        
                    591: 			    elsif ( $Val eq 'incorrect_attempted' || 
                    592:                                 $Val eq 'incorrect_by_override' )
                    593: 		                { $Wrongs = $Tries; $Code = 'N'; }
                    594: 			    $TempHash{"$Part.Code"} = $Code;
                    595: 			    $TempHash{"$Part.Wrongs"} = $Wrongs;
                    596: 			}
                    597:      		    }
1.7       minaeibi  598:                 }
1.1       albertel  599: 		for ( my $n = 0; $n < $PartNo; $n++ ) {		  
                    600: 		    my $part = $TempHash{$n};
                    601: 		    if ($PtrTry ne '') {$PtrTry .= ',';}
                    602: 		    $PtrTry .= "$TempHash{$part.'.Tries'}";
                    603:                     $PtrCod .= "$TempHash{$part.'.Code'}";    
                    604: 		}
                    605:             }
                    606: 	    else { 
                    607: 		for(my $n=0; $n<$PartNo; $n++) { 
                    608: 		    if ($PtrTry ne '') {$PtrTry .= ',';}
                    609: 		    $PtrTry .= "0";
                    610:                     $PtrCod .= "-"; 
                    611: 		}
                    612: 	    }
                    613:         }
                    614:     }
                    615:     $Str .= "\n".'</table>';
                    616:     $r->print($Str);
                    617:     $r->rflush();
                    618: }
                    619: 
1.5       minaeibi  620: sub CreateTable {
1.18      minaeibi  621:     my ($Hd, $Hid)=@_;
1.20      minaeibi  622:     if ($ENV{'form.showcsv'}) { 
1.18      minaeibi  623: 	if ( $Hd == 1 ) {
                    624: 	    $r->print('<br>"'.$hash{'title_'.$Hid}.'","'.$hash{'src_'.$Hid}.'"');
                    625: 	}
                    626: 	return;
                    627:     }
1.7       minaeibi  628:     my $ColNo=0;
                    629:     foreach (keys(%Header)){ 
                    630: 	$ColNo++;
                    631:     } 
1.5       minaeibi  632:     if ( $Hd == 1 ) {
                    633: 	$r->print('<br><a href="'.$hash{'src_'.$Hid}.
1.7       minaeibi  634:                   '" target="_blank">'.$hash{'title_'.$Hid}.'</a>');
1.5       minaeibi  635:     }
                    636:     my $Result = "\n".'<table border=2>';
                    637:     $Result .= '<tr><th>P#</th>'."\n";
1.7       minaeibi  638:     for ( my $nIdx=0; $nIdx < $ColNo; $nIdx++ ) { 
1.5       minaeibi  639: 	$Result .= '<th>'.'<input type="submit" name="sort" value="'.
                    640:                    $Header{$nIdx}.'" />'.'</th>'."\n";
                    641:     }
                    642:     $Result .= "\n".'</tr>'."\n";    
                    643:     $r->print( $Result );
                    644:     $r->rflush();
                    645: }
1.1       albertel  646: 
1.5       minaeibi  647: sub CloseTable {
1.18      minaeibi  648:     if ($ENV{'form.showcsv'}) {
                    649: 	return;
                    650:     }    
1.5       minaeibi  651:     $r->print("\n".'</table>'."\n");
                    652:     $r->rflush();
                    653: }
                    654:  
1.1       albertel  655: # ------------------------------------------- Prepare Statistics Table
                    656: sub PreStatTable {
1.19      minaeibi  657: 
1.1       albertel  658:     my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                    659:                   "_$ENV{'user.domain'}_$cid\_statistics.db";
                    660:     my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                    661:                   "_$ENV{'user.domain'}_$cid\_graph.db";
1.6       minaeibi  662:     my $OpSel11='';
                    663:     my $OpSel12='';
                    664:     my $OpSel13='';
                    665:     my $Status = $ENV{'form.status'};
                    666:     if ( $Status eq 'Any' ) { $OpSel13='selected'; }
                    667:     elsif ($Status eq 'Expired' ) { $OpSel12 = 'selected'; }
                    668:     else { $OpSel11 = 'selected'; }
1.1       albertel  669: 
                    670:     my $Ptr = '';
1.6       minaeibi  671:     $Ptr .= '<br><b> Student Status: &nbsp; </b>'."\n".
                    672:             '<select name="status">'. 
                    673:             '<option '.$OpSel11.' >Active</option>'."\n".
                    674:             '<option '.$OpSel12.' >Expired</option>'."\n".
                    675: 	    '<option '.$OpSel13.' >Any</option> </select> '."\n";
                    676:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                    677:     $Ptr .= '<input type=submit name=sort value="Recalculate Statistics"/>'."\n";
1.1       albertel  678: 
                    679:     $Ptr .= '<br><b> Sorting Type: &nbsp; </b>'."\n".
                    680:             '<select name="order"> <option '.$OpSel1.' >Ascending</option>'."\n".
                    681: 	    '<option '.$OpSel2.'>Descending</option> </select> '."\n";
                    682:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                    683:     $Ptr .= '<input type="submit" name="sort" value="DoDiff Graph" />'."\n";
                    684:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                    685:     $Ptr .= '<input type="submit" name="sort" value="%Wrong Graph" />'."\n";
                    686: 
                    687:     $Ptr .= '<pre>'.
1.7       minaeibi  688:     '<b>  #Stdnts</b>: Total Number of Students opened the problem.<br>'. 
                    689:     '<b>  Tries  </b>: Total Number of Tries for solving the problem.<br>'. 
1.21      minaeibi  690:     '<b>  Mod    </b>: Maximunm Number of Tries for solving the problem.<br>'. 
                    691:     '<b>  Mean   </b>: Average Number of the tries. [ Tries / #Stdnts ]<br>'.
1.7       minaeibi  692:     '<b>  #YES   </b>: Number of students solved the problem correctly.<br>'. 
                    693:     '<b>  #yes   </b>: Number of students solved the problem by override.<br>'.
                    694:     '<b>  %Wrng  </b>: Percentage of students tried to solve the problem but'.
1.2       minaeibi  695:     ' still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]<br>'.
1.8       minaeibi  696: #    '  DoDiff : Degree of Difficulty of the problem. [ Tries/(#YES+#yes+0.1) ]<br>'. Kashy formula
                    697:     '<b>  DoDiff </b>: Degree of Difficulty of the problem. [ 1 - ((#YES+#yes) / Tries) ]<br>'. #Gerd formula
1.7       minaeibi  698:     '<b>  S.D.  </b> : Standard Deviation of the tries.'.
1.21      minaeibi  699:     '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1)'.
1.5       minaeibi  700:     ' where Xi denotes every student\'s tries ]<br>'.
1.7       minaeibi  701:     '<b>  Skew.  </b>: Skewness of the students tries.'.
1.21      minaeibi  702: 	' [ (sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3) ]<br>'.
1.8       minaeibi  703:     '<b>  Dis.F. </b>: Discrimination Factor: A Standard for '.
                    704: 	'evaluating the problem according to a Criterion<br>'.
                    705: 	'<b>           [Applied Criterion in %27 Upper Students - '.
                    706: 	'Applied the same Criterion in %27 Lower Students]</b><br>'.
1.14      minaeibi  707:     '<b>           1st Criterion</b> for Sorting the Students: '.
                    708: 	'<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>'.
                    709:     '<b>           2nd Criterion</b> for Sorting the Students: '.
                    710: 	'<b>Total number of Correct Answers / Total Number of Tries</b>'.	
1.1       albertel  711:             '</pre>';
                    712: 
                    713:     $r->print($Ptr);
1.18      minaeibi  714:     
                    715:     $r->print('Output CSV format: <input type=checkbox name=showcsv onClick="submit()"');
                    716:     if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
                    717:     $r->print('>');
                    718: 
1.1       albertel  719:     $r->rflush();	
                    720: 
                    721:     if ((-e "$CacheDB")&&($ENV{'form.sort'} ne 'Recalculate Statistics')) {
                    722: 	if (tie(%CachData,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) {
                    723: 	    tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640);
                    724: 	    &Cache_Statistics();
                    725:         }
                    726:         else {
                    727: 	    $r->print("Unable to tie hash to db file");
                    728:         }
                    729:     }
                    730:     else {
                    731: 	if (tie(%CachData,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) {
                    732: 	    tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640);
                    733: 	    foreach (keys %DiscFac) {delete $CachData{$_};}
                    734: 	    foreach (keys %CachData) {delete $CachData{$_};}
                    735: 	    $DiscFlag=0;
                    736: 	    &Build_Statistics();
                    737: 	}
                    738:         else {
                    739: 	    $r->print("Unable to tie hash to db file");
                    740:         }
                    741:     }
1.12      minaeibi  742: 
1.15      minaeibi  743: #    $r->print('Total instances of the problems : '.($p_count*($#students+1)));
1.1       albertel  744:     untie(%CachData);
                    745:     untie(%GraphDat);
                    746: }
                    747: 
                    748: 
                    749: # ------------------------------------- Find the section of student in a course
                    750: 
                    751: sub usection {
1.6       minaeibi  752:     my ($udom,$unam,$courseid,$ActiveFlag)=@_;
1.1       albertel  753:     $courseid=~s/\_/\//g;
                    754:     $courseid=~s/^(\w)/\/$1/;
1.22      stredwic  755: 
                    756:     my %result=&Apache::lonnet::dump('roles',$udom,$unam);
1.23      stredwic  757:     my ($checkForResult)=keys(%result);
                    758:     if ($checkForResult=~/^(con_lost|error|no_such_host)/i) {
                    759: 	return -1;
                    760:     }
1.22      stredwic  761:     foreach my $key (keys (%result)) {
                    762: 	my $value=$result{$key};
1.1       albertel  763:         if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
                    764:             my $section=$1;
                    765:             if ($key eq $courseid.'_st') { $section=''; }
1.22      stredwic  766: 	    my ($dummy,$end,$start)=split(/\_/,$value);
1.6       minaeibi  767: 	    if ( $ActiveFlag ne 'Any' ) {
                    768: 		my $now=time;
                    769: 		my $notactive=0;
                    770: 		if ($start) {
                    771: 		    if ($now<$start) { $notactive=1; }
                    772: 		}
                    773: 		if ($end) {
                    774: 		    if ($now>$end) { $notactive=1; }
                    775: 		}
                    776: 		if ((($ActiveFlag eq 'Expired') && $notactive == 1) || 
                    777:                     (($ActiveFlag eq 'Active') && $notactive == 0 ) ) {
                    778: 		    return $section;
                    779: 		}
                    780: 		else { return '-1'; } 
                    781: 	    }
1.1       albertel  782: 	    return $section;
                    783:         }
1.6       minaeibi  784:     }
                    785:     return '-1';
1.1       albertel  786: }
                    787: 
                    788: 
                    789: # ------ Dump the Student's DB file and handling the data for statistics table 
                    790: sub ExtractStudentData {
1.14      minaeibi  791:     my $student=shift;
1.1       albertel  792:     my ($sname,$sdom) = split( /\:/, $student );
1.14      minaeibi  793:     my %result = &Apache::lonnet::dump($cid,$sdom,$sname);
1.1       albertel  794:     my $ResId;
1.5       minaeibi  795:     my $PrOrd;
1.1       albertel  796:     my $Dis = '';
                    797:     my $Code;
                    798:     my $Tries;
                    799:     my $ParCr;
                    800:     my $TotalTries = 0;
                    801:     my $TotalOpend = 0;
                    802:     my $ProbSolved = 0;
                    803:     my $ProbTot = 0;
                    804:     my $TimeTot = 0;
                    805:     my $TotParCr = 0;
                    806:     my $Wrongs;
                    807:     my %TempHash;
1.15      minaeibi  808:     my $Version; 
1.1       albertel  809:     my $LatestVersion;
                    810:     my $SecLimit;
                    811:     my $MapLimit;
1.14      minaeibi  812:     my ($temp)=keys(%result);
1.23      stredwic  813:     unless ($temp=~/^(con_lost|error|no_such_host)/i) {
1.5       minaeibi  814:         foreach my $CurCol(@cols) {
                    815: 	    ($PrOrd,$ResId)=split(/\:/,$CurCol);
                    816: 	    if ( !$CurCol ) { next; }
1.1       albertel  817:             $ResId=~/(\d+)\.(\d+)/;
1.5       minaeibi  818: 	    my $MapId=$1;
                    819: 	    my $PrbId=$2;
1.15      minaeibi  820:             my $MapOrg = $hash{'map_id_'.$MapId};
                    821:             my $Map = &Apache::lonnet::declutter($MapOrg);
1.1       albertel  822:             if ( $CurMap ne 'All Maps' ) {
                    823: 		my ( $ResMap, $NameMap ) = split(/\=/,$CurMap);
                    824: 		if ( $Map ne $ResMap ) { next; }
                    825: 	    }
                    826: 	    my $meta=$hash{'src_'.$ResId};
                    827: 	    my $PartNo = 0;
                    828: 	    $Dis .= ':';
                    829: 	    undef %TempHash;
1.12      minaeibi  830: 
                    831: 	    foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { 
                    832: 		if ($_=~/^stores\_(\w+)\_tries$/) {
1.1       albertel  833:                     my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
                    834: 		    if ( $TempHash{"$Part"} eq '' ) { 
                    835: 			$TempHash{"$Part"} = $Part;
                    836: 			$TempHash{$PartNo}=$Part;
                    837: 			$TempHash{"$Part.Code"} = 'U';  
1.5       minaeibi  838: 			$TempHash{"$Part.PrOrd"} = $PrOrd+$PartNo;
1.1       albertel  839: 			$PartNo++;
                    840: 		    }
1.14      minaeibi  841:                     #my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
1.1       albertel  842: 		}
1.5       minaeibi  843:             }
1.15      minaeibi  844:             &Apache::lonnet::declutter( $hash{'src_'.$ResId} );
                    845: 	    my $URI = $hash{'src_'.$ResId};
1.5       minaeibi  846:             my $Prob = $Map.'___'.$PrbId.'___'.
1.15      minaeibi  847:                        &Apache::lonnet::declutter($URI);
1.1       albertel  848:             $Code='U';
                    849:             $Tries = 0;
                    850: 	    $ParCr = 0;
                    851:             $Wrongs = 0;
1.15      minaeibi  852:   	    $LatestVersion = $result{"version:$Prob"};        
1.1       albertel  853: 	    if ( $LatestVersion ) {
                    854: 		for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
                    855: 		    my $vkeys = $result{"$Version:keys:$Prob"};
                    856: 		    my @keys = split(/\:/,$vkeys);		
                    857: 		    foreach my $Key (@keys) {		  
                    858: 			if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
                    859: 			    my $Part = $1;
                    860: 			    $Tries = $result{"$Version:$Prob:resource.$Part.tries"};
                    861: 			    $ParCr = $result{"$Version:$Prob:resource.$Part.awarded"};
                    862: 			    my $Time = $result{"$Version:$Prob:timestamp"};
                    863: 			    $TempHash{"$Part.Time"} = ($Time) ? $Time : 0;
                    864: 			    $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0;
                    865: 			    $TempHash{"$Part.ParCr"} = ($ParCr) ? $ParCr : 0;        
                    866: 			    $TotalTries += $TempHash{"$Part.Tries"};
                    867: 			    $TotParCr += $TempHash{"$Part.ParCr"};
                    868: 			    my $Val = $result{"$Version:$Prob:resource.$Part.solved"};
                    869: 			    if ( $Val eq 'correct_by_student' )
                    870:                                { $Wrongs = $Tries - 1; $Code = 'C'; } 
                    871: 			    elsif ( $Val eq 'correct_by_override' )
                    872:                                { $Wrongs = $Tries - 1; $Code = 'O'; }                        
                    873: 			    elsif ( $Val eq 'incorrect_attempted' || 
                    874:                                 $Val eq 'incorrect_by_override' )
                    875: 		               { $Wrongs = $Tries; $Code = 'I'; }
                    876: 			    $TempHash{"$Part.Code"} = $Code;
                    877: 			    $TempHash{"$Part.Wrongs"} = $Wrongs;
                    878: 			}
                    879:      		    }
                    880:                 } 
                    881: 		for ( my $n = 0; $n < $PartNo; $n++ ) {		  
                    882: 		    my $part = $TempHash{$n};
                    883: 		    my $Yes = 0;
                    884:                     if ( $TempHash{$part.'.Code'} eq 'C' ||
                    885:                          $TempHash{$part.'.Code'} eq 'O'  ) 
1.7       minaeibi  886: 		       {$ProbSolved++;$Yes=1;}		
                    887: 
                    888:  #		    my $ptr = "$hash{'title_'.$ResId}";
1.12      minaeibi  889: 		    my $ptr = $TempHash{$part.'.PrOrd'}.'&'.$ResId;
1.7       minaeibi  890: 
1.1       albertel  891: 		    if ( $PartNo > 1 ) {                
1.5       minaeibi  892: 			$ptr .= "*(part $part)";
1.12      minaeibi  893: 			$Dis .= '&';
1.1       albertel  894: 		    }
                    895: 		    my $Fac = ($TempHash{"$part.Tries"}) ? 
                    896:                               ($TempHash{"$part.ParCr"}/$TempHash{"$part.Tries"}) : 0;
                    897: 		    my $DisF;
                    898: 		    if ( $Fac > 0 &&  $Fac < 1 ) { 
                    899: 			$DisF = sprintf( "%.4f", $Fac );
                    900: 		    }
                    901: 		    else {$DisF = $Fac;}
1.15      minaeibi  902: #		    $DisF .= '+'.$TempHash{"$part.Time"};33333333
1.1       albertel  903: 		    $TimeTot += $TempHash{"$part.Time"};
1.7       minaeibi  904: 		    $Dis .= $TempHash{$part.'.PrOrd'}.'='.$DisF.'+'.$Yes;
1.12      minaeibi  905: 		    $ptr .= "&$TempHash{$part.'.Tries'}".
                    906: 		            "&$TempHash{$part.'.Wrongs'}".
                    907:                             "&$TempHash{$part.'.Code'}";
1.1       albertel  908: 		    push (@list, $ptr);
                    909: 		    $TotalOpend++;
                    910: 		    $ProbTot++;
                    911: 		}
                    912:             }
1.5       minaeibi  913: 	    #else { 
                    914: 		#for(my $n=0; $n<$PartNo; $n++) {
1.11      minaeibi  915: 		#    push (@list, "$TempHash{'0'.'.PrOrd'}.':'.$ResId:0:0:U");
1.5       minaeibi  916: 		#    $ProbTot++; 
                    917: 		#}
                    918: 	    #}
1.1       albertel  919:         }
                    920: 	if ( $TotalTries ) {
                    921: 	    my $DisFac = ( $TotalTries ) ? ($TotParCr/$TotalTries) : 0;
                    922: 	    my $DisFactor = sprintf( "%.4f", $DisFac );
1.7       minaeibi  923: 	    $DiscFac{$DisFactor}=$Dis;
                    924: 	    #my $time;
                    925: 	    #if ($ProbSolved){
                    926: 		#$time = int(($TimeTot/$ProbSolved)-10000000);
                    927: 	    #}
                    928: 	    #$DiscFac{($DisFactor.':'.$sname.':'.$ProbTot.':'.$TotalOpend.':'.
                    929:             #          $TotalTries.':'.$ProbSolved.':'.$time)}=$Dis;
1.1       albertel  930: 	}
                    931:     }
                    932:     #$r->print($sname.' PrCr= '.$TotParCr.' Slvd= '.$ProbSolved.' Tries='.$TotalTries.'<br>');
                    933: }
                    934: 
                    935: 
1.21      minaeibi  936: 
1.1       albertel  937: # ------------------------------------------------------------ Build page table
                    938: sub tracetable {
                    939:     my ($rid,$beenhere)=@_;
1.12      minaeibi  940:     my $IsMap=0;
1.1       albertel  941:     $rid=~/(\d+)\.(\d+)/;
                    942:     $maps{&Apache::lonnet::declutter($hash{'map_id_'.$1})}='';#$hash{'title_'.$rid}; 
1.5       minaeibi  943:     #$maps{$HWN}=$hash{'title_'.$rid}; 
1.1       albertel  944:     unless ($beenhere=~/\&$rid\&/) {
                    945:        $beenhere.=$rid.'&'; 
                    946:        if (defined($hash{'is_map_'.$rid})) {
                    947: 	   my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}};
                    948:            if ( $cmap eq 'sequence' || $cmap eq 'page' ) { 
                    949:                $cols[$#cols+1]=0;
1.5       minaeibi  950: 	       $P_Order++;
                    951: 	       $HWN=$P_Order;
1.12      minaeibi  952:                $mapsort{$HWN} = $rid.':';
                    953: 	       $IsMap=1;
                    954:  
1.1       albertel  955:                #$maps{&Apache::lonnet::declutter($hash{'src_'.$rid})}= 
                    956:                #      $hash{'title_'.$rid}; 
                    957:            }
                    958:            if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
                    959:                (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
1.5       minaeibi  960: 	       my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
1.1       albertel  961: 
1.5       minaeibi  962:                &tracetable($hash{'map_start_'.$hash{'src_'.$rid}},
                    963: 			   '&'.$frid.'&');
1.1       albertel  964: 
1.5       minaeibi  965: 	       $cols[$#cols+1]=($P_Order+1).':'.$frid;
                    966:       
                    967: 	       my $meta=$hash{'src_'.$frid};
                    968: 	       my $PartNo = 0;
1.14      minaeibi  969: 	       my $Part;
1.13      minaeibi  970: 	#       if ($IsMap==0){
1.5       minaeibi  971:                if ($meta) {
                    972: 		   if ($meta=~/\.(problem|exam|quiz|assess|survey|form)$/) {
                    973: 		       foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
1.12      minaeibi  974: 			   if ($_=~/^stores\_(\w+)\_tries$/) {
1.14      minaeibi  975: 			       $Part=&Apache::lonnet::metadata($meta,$_.'.part');
1.5       minaeibi  976: 			       $P_Order++;
                    977: 			       $mapsort{$HWN} .= '&'.$P_Order;
                    978: 			       $PartNo++;
1.11      minaeibi  979: 			       #$r->print('<br>'.$PartNo.'---'.$P_Order);
1.5       minaeibi  980: 			   }
1.14      minaeibi  981: 			   foreach my $K(split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {
                    982: 			       if ($K=~/^optionresponse\_($Part)\_(\w+)$/) {
                    983: 				   #$r->print('<br>'.$_.'...'.$P_Order.'---'.$Part);
1.16      minaeibi  984: 				   $OpResp{$P_Order}="$frid:$Part";
1.14      minaeibi  985: 			       } 
                    986: 			   }
1.5       minaeibi  987: 		       }
                    988: 		   }
                    989:                }
1.1       albertel  990: 	   }
1.13      minaeibi  991: 	 #  }
1.1       albertel  992:        } else {
1.5       minaeibi  993: 	   $cols[$#cols+1]=($P_Order+1).':'.$rid;
                    994: 	   my $meta=$hash{'src_'.$rid};
                    995: 	   my $PartNo = 0;
1.12      minaeibi  996: 	   if ($meta) {
1.5       minaeibi  997: 	       if ($meta=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1.12      minaeibi  998: 		   foreach my $Key(split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
                    999: 		       if ($Key=~/^stores\_(\w+)\_tries$/) {
                   1000: 			   my $Part=&Apache::lonnet::metadata($meta,$Key.'.part');
1.5       minaeibi 1001: 			   $P_Order++;
                   1002: 			   $mapsort{$HWN} .= '&'.$P_Order;
                   1003: 			   $PartNo++;
1.12      minaeibi 1004: 			   foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {
                   1005: 			       if ($_=~/^optionresponse\_($Part)\_(\w+)$/) {
                   1006: 				   #$r->print('<br>'.$_.'...'.$P_Order.'---'.$Part);
1.16      minaeibi 1007: 				   $OpResp{$P_Order}="$rid:$Part";;
1.12      minaeibi 1008: 			       } 
                   1009: 		   
                   1010: 			   }
                   1011: 
1.5       minaeibi 1012: 		       }
                   1013: 		   }
                   1014: 	       }
1.12      minaeibi 1015: 	   }       
1.1       albertel 1016:        }
                   1017:        if (defined($hash{'to_'.$rid})) {
1.5       minaeibi 1018:           foreach (split(/\,/,$hash{'to_'.$rid})){
1.1       albertel 1019:               &tracetable($hash{'goesto_'.$_},$beenhere);
1.5       minaeibi 1020:           }
1.1       albertel 1021:        }
                   1022:     }
                   1023: }
                   1024: 
                   1025: sub MySort {          
1.6       minaeibi 1026:     if ( $Pos > 0 ) {
1.1       albertel 1027: 	if ($ENV{'form.order'} eq 'Descending') {$b <=> $a;}
                   1028: 	else { $a <=> $b; }
                   1029:     }
                   1030:     else {
                   1031: 	if ($ENV{'form.order'} eq 'Descending') {$b cmp $a;}
                   1032: 	else { $a cmp $b; }
                   1033:     }
                   1034: }
                   1035: 
1.15      minaeibi 1036: sub Create_PrgWin {
                   1037: #----------- Create progress
1.1       albertel 1038:     $r->print(<<ENDPOP);
1.5       minaeibi 1039:     <script>
1.1       albertel 1040:     popwin=open('','popwin','width=400,height=100');
1.7       minaeibi 1041:     popwin.document.writeln('<html><body bgcolor="#88DDFF">'+
1.1       albertel 1042:       '<title>LON-CAPA Statistics</title>'+
                   1043:       '<h4>Computation Progress</h4>'+
                   1044:       '<form name=popremain>'+
                   1045:       '<input type=text size=35 name=remaining value=Starting></form>'+
                   1046:       '</body></html>');
                   1047:     popwin.document.close();
1.5       minaeibi 1048:     </script>
1.1       albertel 1049: ENDPOP
                   1050: 
                   1051:     $r->rflush();
1.15      minaeibi 1052: }
                   1053: 
                   1054: 
                   1055: sub Update_PrgWin {
1.1       albertel 1056: #----------- update progress
1.15      minaeibi 1057:     my $index = shift;
                   1058:     $r->print('<script>popwin.document.popremain.remaining.value="'.
                   1059:               'Computing '.($index+1).'/'.($#students+1).': '.
                   1060:               $students[$index].'";</script>');
                   1061:     $r->rflush();
                   1062: }
                   1063: 
                   1064: sub Close_PrgWin {
                   1065: #--------------------- close Progress Line
                   1066:     $r->print('<script>popwin.close()</script>');
                   1067:     $r->rflush(); 
                   1068: }
1.1       albertel 1069: 
1.15      minaeibi 1070: sub Build_Statistics {
                   1071:     &Create_PrgWin();
                   1072: # ---------------------------- Gathering the Data of students' tries
                   1073:     for (my $index=0;$index<=$#students;$index++) {
                   1074: 	&Update_PrgWin($index);
1.14      minaeibi 1075:         &ExtractStudentData($students[$index]);
1.1       albertel 1076:     }
1.7       minaeibi 1077: 
1.1       albertel 1078: # -------------------- sorting the Data
1.7       minaeibi 1079:     $r->print('<script>popwin.document.popremain.remaining.value="'.
                   1080:               'Calculating Discrimination Factors...";</script>');
                   1081: 
1.5       minaeibi 1082:     @list = sort (@list);
                   1083: 
1.7       minaeibi 1084:     &Discriminant();
                   1085: 
1.1       albertel 1086:     $OpSel2='';
                   1087:     $OpSel1='selected';
                   1088:  		   
                   1089:     $p_count = 0; 
                   1090:     my $nIdx = 0;
                   1091:     my $dummy; 
                   1092:     my $p_val;
                   1093:     my $ResId;
                   1094:     my $NoElements = $#list + 1;
                   1095: #-------------------------------- loop for data representation
1.5       minaeibi 1096:     foreach (sort keys %mapsort) {
                   1097: 	my ($Hid,$pr)=split(/\:/,$mapsort{$_});
                   1098: 	my @lpr=split(/\&/,$pr);
                   1099: 	&CreateTable(1,$Hid);
                   1100: 	for (my $i=1; $i<=$#lpr; $i++) {
                   1101: 	    my %storestats=();
1.12      minaeibi 1102: 	    my ($PrOrd,$Prob,$Tries,$Wrongs,$Code)=split(/\&/,$list[$nIdx]);
1.5       minaeibi 1103: 	    my $Temp = $Prob;
                   1104: 	    my $MxTries = 0;
                   1105: 	    my $TotalTries = 0;
                   1106: 	    my $YES = 0;
                   1107: 	    my $Incorrect = 0;
                   1108: 	    my $Override = 0;
                   1109: 	    my $StdNo = 0;
                   1110: 	    my @StdLst;
                   1111: 	    while ( $PrOrd == $lpr[$i] ) 
                   1112: 	    {
                   1113: 		$nIdx++;
                   1114: 		$StdNo++;
                   1115: 		$StdLst[ $StdNo ] = $Tries;
                   1116: 		$TotalTries += $Tries;
                   1117: 		if ( $MxTries < $Tries ) { $MxTries = $Tries; } 
                   1118: 		if ( $Code eq 'C' ){ $YES++; }
                   1119: 		elsif( $Code eq 'I' ) { $Incorrect++; }
                   1120: 		elsif( $Code eq 'O' ) { $Override++; }
                   1121: 		elsif( $Code eq 'U' ) { $StdNo--; }
1.12      minaeibi 1122: 		($PrOrd,$Prob,$Tries,$Wrongs,$Code)=split(/\&/,$list[$nIdx]);
1.5       minaeibi 1123: 	    }	
                   1124: 
                   1125: 	    $p_count++;
                   1126: 	    my $Dummy;
                   1127: 	    ($ResId,$Dummy)=split(/\*/,$Temp);
1.1       albertel 1128: 
1.5       minaeibi 1129: 	    $Temp = '<a href="'.$hash{'src_'.$ResId}.
                   1130:                 '" target="_blank">'.$hash{'title_'.$ResId}.$Dummy.'</a>';
1.15      minaeibi 1131: 
1.5       minaeibi 1132: 	    my $res = &Apache::lonnet::declutter($hash{'src_'.$ResId});
                   1133: 	    my $urlres=$res;
1.1       albertel 1134: 
1.5       minaeibi 1135: 	    $ResId=~/(\d+)\.(\d+)/;
                   1136: 	    my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
                   1137: 	    $urlres=$Map;
1.1       albertel 1138:  
1.5       minaeibi 1139: 	    $res = '<a href="'.$hash{'src_'.$ResId}.'">'.$res.'</a>';
                   1140: 	    #$Map = '<a href="'.$Map.'">'.$res.'</a>';
1.1       albertel 1141: 
                   1142: #------------------------ Compute the Average of Tries about one problem
1.5       minaeibi 1143: 	    my $Average = ($StdNo) ? $TotalTries/$StdNo : 0;
1.1       albertel 1144: 
1.5       minaeibi 1145: 	    $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___timestamp'}=time;       
                   1146: 	    $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___stdno'}=$StdNo;
                   1147: 	    $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___avetries'}=$Average;
1.1       albertel 1148:    
                   1149: #-------------------------------- Compute percentage of Wrong tries
1.5       minaeibi 1150: 	    my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0;
1.1       albertel 1151: 
                   1152: #-------------------------------- Compute Standard Deviation
1.5       minaeibi 1153: 	    my $StdDev = 0; 
                   1154: 	    if ( $StdNo > 1 ) {
                   1155: 		for ( my $n = 0; $n < $StdNo; $n++ ) {
                   1156: 		    my $Dif = $StdLst[ $n ]-$Average;
                   1157: 		    $StdDev += $Dif*$Dif;
                   1158: 		} 
                   1159: 		$StdDev /= ( $StdNo - 1 );
                   1160: 		$StdDev = sqrt( $StdDev );
                   1161: 	    }
1.1       albertel 1162: 
                   1163: #-------------------------------- Compute Degree of Difficulty
1.5       minaeibi 1164: 	    my $DoDiff = 0;
                   1165: 	    if( $TotalTries > 0 ) {
                   1166: 		$DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries );
1.1       albertel 1167: #	    $DoDiff =  ($TotalTries)/($YES + $Override+ 0.1);	    
1.5       minaeibi 1168: 	    }
1.1       albertel 1169:        
1.5       minaeibi 1170: 	    $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff;
1.1       albertel 1171: 
                   1172: #-------------------------------- Compute the Skewness
1.5       minaeibi 1173: 	    my $Skewness = 0;
                   1174: 	    my $Sum = 0; 
                   1175: 	    if ( $StdNo > 0 && $StdDev > 0 ) {
                   1176: 		for ( my $n = 0; $n < $StdNo; $n++ ) {
                   1177: 		    my $Dif = $StdLst[ $n ]-$Average;
                   1178: 		    $Skewness += $Dif*$Dif*$Dif;
                   1179: 		} 
                   1180: 		$Skewness /= $StdNo;
1.15      minaeibi 1181: 		$Skewness /= $StdDev*$StdDev*$StdDev;
1.5       minaeibi 1182: 	    }
1.7       minaeibi 1183: 
                   1184: #--------------------- Compute the Discrimination Factors
1.8       minaeibi 1185: 	    my ($Up1,$Up2)=split(/\:/,$DisUp{$lpr[$i]});
                   1186: 	    my ($Lw1,$Lw2)=split(/\:/,$DisLow{$lpr[$i]});
                   1187: 	    my $Dis1 = $Up1 - $Lw1;
                   1188: 	    my $Dis2 = $Up2 - $Lw2;
                   1189: 	    my $_D1 = sprintf("%.2f", $Dis1);
                   1190: 	    my $_D2 = sprintf("%.2f", $Dis2);
1.7       minaeibi 1191: 
1.1       albertel 1192: #-----------------  Some restition in presenting the float numbers
1.5       minaeibi 1193: 	    my $Avg = sprintf( "%.2f", $Average );
                   1194: 	    my $Wrng = sprintf( "%.1f", $Wrong );
                   1195: 	    my $SD = sprintf( "%.1f", $StdDev );
                   1196: 	    my $DoD = sprintf( "%.2f", $DoDiff );
                   1197: 	    my $Sk = sprintf( "%.1f", $Skewness );
1.15      minaeibi 1198: 	    my $join = $lpr[$i].'&'.$Temp.'&'.$StdNo.'&'.
1.12      minaeibi 1199:                        $TotalTries.'&'.$MxTries.'&'.$Avg.'&'.
                   1200:                        $YES.'&'.$Override.'&'.$Wrng.'&'.$DoD.'&'.
1.15      minaeibi 1201: 		       $SD.'&'.$Sk.'&'.$_D1.'&'.$_D2.'&'.
                   1202:                        $Prob;
1.5       minaeibi 1203: 	    $CachData{($p_count-1)}=$join;
                   1204: 
                   1205: 	    $urlres=~/^(\w+)\/(\w+)/;
                   1206: 	    if ($StdNo) { 
                   1207: 		&Apache::lonnet::put('resevaldata',\%storestats,$1,$2); 
                   1208: 	    }
1.1       albertel 1209: #-------------------------------- Row of statistical table
1.5       minaeibi 1210: 	    if ( $DiscFlag == 0 ) {
                   1211: 		&TableRow($join,$i,($p_count-1));
                   1212: 	    } 
                   1213: 	}
                   1214: 	&CloseTable();
1.1       albertel 1215:     }
1.15      minaeibi 1216:     &Close_PrgWin();
1.1       albertel 1217: }
                   1218: 
                   1219: sub Cache_Statistics {
                   1220:     my @list = ();
                   1221:     my $Useful;
                   1222:     my $UnUseful;
1.20      minaeibi 1223: #    $r->print('<input type="hidden" name="show" value="excel" />'."\n"); 
1.1       albertel 1224:     my %myHeader = reverse( %Header );
                   1225:     $Pos = $myHeader{$ENV{'form.sort'}};
1.5       minaeibi 1226:     if ($Pos > 0) {$Pos++;}
1.1       albertel 1227:     $p_count = 0;
                   1228:     foreach my $key( keys %CachData) { 
1.12      minaeibi 1229: 	my @Temp=split(/\&/,$CachData{$key});
1.6       minaeibi 1230: 	if ( $Pos == 0 ) {
1.1       albertel 1231: 	    ($UnUseful,$Useful)=split(/\>/,$Temp[$Pos]);
                   1232: 	}
                   1233: 	else {
                   1234: 	    $Useful = $Temp[$Pos];
                   1235: 	}   
1.12      minaeibi 1236: 	$list[$p_count]=$Useful.'@'.$CachData{$key};
1.1       albertel 1237:         $p_count++;
                   1238:     }
                   1239: 
                   1240:     @list = sort MySort (@list);
                   1241: 
1.5       minaeibi 1242:     my $nIdx=0;
                   1243: 
                   1244:     if ( $Pos == 0 ) {
                   1245: 	foreach (sort keys %mapsort) {
                   1246: 	    my ($Hid,$pr)=split(/\:/,$mapsort{$_});
                   1247: 	    &CreateTable(1,$Hid);
                   1248: 	    my @lpr=split(/\&/,$pr);
                   1249: 	    for (my $i=1; $i<=$#lpr; $i++) {
1.12      minaeibi 1250: 		my($Pre, $Post) = split(/\@/,$list[$nIdx]); 
                   1251: 		#$r->print('<br>'.$Pre.'---'.$Post);
1.5       minaeibi 1252: 		&TableRow($Post,$i,$nIdx);
                   1253: 		$nIdx++;
                   1254: 	    }
                   1255: 	    &CloseTable();
                   1256: 	}
                   1257:     }
                   1258:     else {
                   1259: 	&CreateTable(0);
                   1260: 	for ( my $nIdx = 0; $nIdx < $p_count; $nIdx++ ) {
1.12      minaeibi 1261: 	    my($Pre, $Post) = split(/\@/,$list[$nIdx]); 
1.5       minaeibi 1262: 	    &TableRow($Post,$nIdx,$nIdx);
                   1263: 	} 
                   1264: 	&CloseTable();
                   1265:     }
                   1266: }
                   1267: 
                   1268: sub TableRow {
                   1269:     my ($Str,$Idx,$RealIdx)=@_;
1.12      minaeibi 1270:     my($PrOrd,$Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override,
                   1271:        $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$Prob)=split(/\&/,$Str);	
1.18      minaeibi 1272:     if ($ENV{'form.showcsv'}) {
                   1273:         my ($ResId,$Dummy)=split(/\*/,$Prob);
                   1274:         my $Ptr =  "\n".'<br>'.
                   1275:                "\n".'"'.($RealIdx+1).'",'.
                   1276:                "\n".'"'.$hash{'title_'.$ResId}.$Dummy.'",'.
                   1277:                "\n".'"'.$hash{'src_'.$ResId}.'",'.
                   1278:                "\n".'"'.$StdNo.'",'.
                   1279:                "\n".'"'.$TotalTries.'",'.
                   1280:                "\n".'"'.$MxTries.'",'.
                   1281:                "\n".'"'.$Avg.'",'.
                   1282:                "\n".'"'.$YES.'",'.
                   1283:                "\n".'"'.$Override.'",'.
                   1284:                "\n".'"'.$Wrng.'",'.
                   1285:                "\n".'"'.$DoD.'",'.
                   1286:                "\n".'"'.$SD.'",'.
                   1287:                "\n".'"'.$Sk.'",'.
                   1288:                "\n".'"'.$_D1.'",'.
                   1289: 	       "\n".'"'.$_D2.'"';
                   1290:         $r->print("\n".$Ptr);
                   1291:     }
                   1292:     else{
                   1293:         my $Ptr =  "\n".'<tr>'.
1.5       minaeibi 1294:                "\n".'<td>'.($RealIdx+1).'</td>'.
1.13      minaeibi 1295:           #     "\n".'<td>'.$PrOrd.$Temp.'</td>'.
1.8       minaeibi 1296:                "\n".'<td>'.$Temp.'</td>'.
1.25      minaeibi 1297:                "\n".'<td bgcolor='.$color{"yellow"}.'> '.$StdNo.'</td>'.
                   1298:                "\n".'<td bgcolor='.$color{"yellow"}.'>'.$TotalTries.'</td>'.
                   1299:                "\n".'<td bgcolor='.$color{"yellow"}.'>'.$MxTries.'</td>'.
                   1300:                "\n".'<td bgcolor='.$color{"gb"}.'>'.$Avg.'</td>'.
                   1301:                "\n".'<td bgcolor='.$color{"gb"}.'> '.$YES.'</td>'.
                   1302:                "\n".'<td bgcolor='.$color{"gb"}.'> '.$Override.'</td>'.
                   1303:                "\n".'<td bgcolor='.$color{"red"}.'> '.$Wrng.'</td>'.
                   1304:                "\n".'<td bgcolor='.$color{"red"}.'> '.$DoD.'</td>'.
                   1305:                "\n".'<td bgcolor='.$color{"green"}.'> '.$SD.'</td>'.
                   1306:                "\n".'<td bgcolor='.$color{"green"}.'> '.$Sk.'</td>'.
                   1307:                "\n".'<td bgcolor='.$color{"purple"}.'> '.$_D1.'</td>'.
                   1308: 	       "\n".'<td bgcolor='.$color{"purple"}.'> '.$_D2.'</td>';
1.18      minaeibi 1309:         $r->print("\n".$Ptr.'</tr>' );
                   1310:     }
1.5       minaeibi 1311:     $GraphDat{$RealIdx}=$DoD.':'.$Wrng;
1.1       albertel 1312: }
                   1313: 
                   1314: # ------------------------------------------- Prepare data for Graphical chart
                   1315: 
                   1316: sub GetGraphData {
1.17      minaeibi 1317:     my $ylab = shift;
1.1       albertel 1318:     my $Col;
                   1319:     my $data='';
                   1320:     my $count = 0;
                   1321:     my $Max = 0;
                   1322:     my $cid=$ENV{'request.course.id'};
                   1323:     my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                   1324:                   "_$ENV{'user.domain'}_$cid\_graph.db";
                   1325:     foreach (keys %GraphDat) {delete $GraphDat{$_};}
                   1326:     if (-e "$GraphDB") {
                   1327: 	if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) {
1.17      minaeibi 1328: 	    if ( $ylab eq 'DoDiff Graph' ) {
                   1329: 		$ylab = 'Degree-of-Difficulty';
1.1       albertel 1330: 		$Col = 0;
                   1331: 	    }
                   1332: 	    else {
1.17      minaeibi 1333: 		$ylab = 'Wrong-Percentage';
1.1       albertel 1334: 		$Col = 1;
                   1335: 	    }
                   1336: 	    foreach (sort NumericSort keys %GraphDat) { 
                   1337: 		my @Temp=split(/\:/,$GraphDat{$_});
                   1338:                 my $inf = $Temp[$Col]; 
                   1339: 		if ( $Max < $inf ) {$Max = $inf;}
                   1340: 		$data .= $inf.',';
                   1341: 		$count++;
                   1342: 	    }
1.15      minaeibi 1343: 	    if ( $Max > 1 ) { 
                   1344: 		$Max += (10 - $Max % 10);
                   1345: 		$Max = int($Max);
                   1346: 	    }
                   1347: 	    else { $Max = 1; }
1.1       albertel 1348:             untie(%GraphDat);
                   1349: 	    my $Course = $ENV{'course.'.$cid.'.description'};
                   1350: 	    $Course =~ s/\ /"_"/eg;
1.17      minaeibi 1351: 	    $GData=$Course.'&'.'Problems'.'&'.$ylab.'&'.$Max.'&'.$count.'&'.$data;
1.1       albertel 1352: 	}
                   1353: 	else {
                   1354: 	    $r->print("Unable to tie hash to db file");
                   1355: 	}
                   1356:     }
                   1357: }
                   1358: 
                   1359: 
                   1360: sub initial {
                   1361: # --------------------------------- Initialize the global varaibles
1.25      minaeibi 1362:     undef @students;
                   1363:     undef @cols;
                   1364:     undef %maps;
                   1365:     undef %section;
                   1366:     undef %StuBox;
                   1367:     undef @list;
                   1368:     undef %CachData;
                   1369:     undef %GraphDat;
                   1370:     undef %DiscFac;
                   1371:     undef %OpResp;
                   1372:     undef %ConceptData;
                   1373:     undef $CurMap;
                   1374:     undef $CurSec;
                   1375:     undef $CurStu;
                   1376:     undef $p_count;
                   1377:     undef $Pos;
                   1378:     undef $GData;
                   1379:     $DiscFlag=0; 
                   1380:     $P_Order=100000;
                   1381:     $HWN=$P_Order;
                   1382:     &setbgcolor(0);
                   1383: }
                   1384: 
                   1385: # For loading the colored table for display or un-colored for print
                   1386: sub setbgcolor {
                   1387:     my $PrintTable=shift;
                   1388:     undef %color;
                   1389:     if ($PrintTable){
                   1390: 	$color{"gb"}="#FFFFFF";
                   1391: 	$color{"red"}="#FFFFFF";
                   1392: 	$color{"yellow"}="#FFFFFF";
                   1393: 	$color{"green"}="#FFFFFF";
                   1394: 	$color{"purple"}="#FFFFFF";
                   1395:     } else {
                   1396: 	$color{"gb"}="#DDFFFF";
                   1397: 	$color{"red"}="#FFDDDD";
                   1398: 	$color{"yellow"}="#EEFFCC";
                   1399: 	$color{"green"}="#DDFFDD";
                   1400: 	$color{"purple"}="#FFDDFF";
                   1401:     }
1.1       albertel 1402: }
                   1403: 
1.19      minaeibi 1404: #	my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                   1405: #                  "_$ENV{'user.domain'}_$cid\_classlist.db";
                   1406: #	if (-e "$CacheDB") {
                   1407: #	    if (tie(%students,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) {
                   1408: #		&CachClassList();
                   1409: #	    }
                   1410: #            else {
                   1411: #	        $r->print("Unable to tie hash to db file");
                   1412: #            }
                   1413: #        }
                   1414: #        else {
                   1415: #	    if (tie(%students,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) {
                   1416: #	        &MakeClassList();
                   1417: #	    }
                   1418: #            else {
                   1419: #	        $r->print("Unable to tie hash to db file");
                   1420: #            }
                   1421: #        }
                   1422: #        untie(%students);
                   1423: 
1.1       albertel 1424: sub ClassList {
                   1425: 
                   1426:     &GetStatus();
                   1427: 
                   1428:     $cid=$ENV{'request.course.id'};
                   1429:     my ($cdom,$cnum)=split(/\_/,$cid);
                   1430: # ----------------------- Get first and last resource, see if there is anything
                   1431:     $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
                   1432:     $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
                   1433:     if (($firstres) && ($lastres)) {
1.20      minaeibi 1434: 
1.23      stredwic 1435: 	my $StudNo = 0;
                   1436: 	my $now=time;
1.22      stredwic 1437: 	my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum);
1.20      minaeibi 1438: 
1.24      stredwic 1439: 	my ($checkForError)=keys(%classlist);
1.23      stredwic 1440: 	if($checkForError=~/^(con_lost|error|no_such_host)/i) {
                   1441: 	    $r->print('<h1>Could not access course data</h1>');
                   1442: 	} else {
1.26    ! minaeibi 1443: 	    foreach my $name (sort keys (%classlist)) {
1.23      stredwic 1444: 		my $value=$classlist{$name};
                   1445: 		my ($end,$start)=split(/\:/,$value);
                   1446: 		my $active=1;
                   1447: 		my $Status=$ENV{'form.status'};
                   1448: 		$Status = ($Status) ? $Status : 'Active';
                   1449: 		if ( ( ($end) && $now > $end ) && 
                   1450: 		     ( ($Status eq 'Active') ) ) { $active=0; }
                   1451: 		if ( ($Status eq 'Expired') && 
                   1452: 		     ($end == 0 || $now < $end) ) { $active=0; }
                   1453: 		if ($active) {
                   1454: 		    my $thisindex=$#students+1;
                   1455: 		    $students[$thisindex]=$name;
                   1456: 		    my ($sname,$sdom)=split(/\:/,$name);
                   1457: 		    my $ssec=&usection($sdom,$sname,$cid,$Status);
                   1458: 		    if ($ssec==-1 || $ssec eq 'adm' ) {next;}
                   1459: 		    $ssec=($ssec) ? $ssec : '(none)';
                   1460: 		    #$ssec=(int($ssec)) ? int($ssec) : $ssec;
                   1461: 		    $section{$ssec}=$ssec;
                   1462: 		    if ($CurSec eq 'All Sections' || $ssec eq $CurSec) {
                   1463: 			$students[$StudNo]=$name;
                   1464: 			$StuBox{$sname}=$sdom;
                   1465: 		    }
                   1466: 		    $StudNo++;
1.22      stredwic 1467: 		}
1.1       albertel 1468: 	    }
                   1469: 	}
1.22      stredwic 1470: 
1.1       albertel 1471:         $r->print("Total number of students : ".($#students+1));
                   1472:         $r->rflush();
                   1473: # --------------- Find all assessments and put them into some linear-like order
                   1474: 	&tracetable($firstres,'&'.$lastres.'&');
1.5       minaeibi 1475: #    my $c=0;
                   1476: #    foreach (sort keys %mapsort) {
                   1477: #	$r->print('<br>'.$c.')'.$_.' ... '.$mapsort{$_});
                   1478: #	$c++;
                   1479: #    }
1.15      minaeibi 1480: #	my $c=1;
                   1481: #	foreach (sort keys %OpResp) {
                   1482: #	    $r->print('<br>'.$c.')'.$_.' ... '.$OpResp{$_}.' ... '.$hash{'src_'.$OpResp{$_}});
                   1483: #	    $c++;
                   1484: #	}
                   1485: 
1.1       albertel 1486:     }
                   1487: 
                   1488: # ------------------------------------------------------------- End render page 
                   1489:     else {
                   1490: 	$r->print('<h3>Undefined course sequence</h3>');
                   1491:     }
1.15      minaeibi 1492: }
                   1493: 
                   1494: 
                   1495: sub Title {
                   1496:     $r->print('<html><head><title>LON-CAPA Statistics</title></head>');
                   1497:     $r->print('<body bgcolor="#FFFFFF">'.
                   1498:               '<script>window.focus(); window.width=500;window.height=500;</script>'.
                   1499:               '<img align=right src=/adm/lonIcons/lonlogos.gif>');
                   1500: # ---------------------------------------------------------------- Course title
                   1501:     $r->print('<h1> Course : "'.
                   1502:               $ENV{'course.'.$ENV{'request.course.id'}.
                   1503:               '.description'}.'"</h1><h2>'.localtime().'</h2>');
                   1504: # ------------------------------- This is going to take a while, produce output
                   1505:     $r->rflush();	
                   1506: }
                   1507: 
1.19      minaeibi 1508: 
1.15      minaeibi 1509: sub CreateForm {
                   1510:     $r->print("\n".'<form name=stat method=post action="/adm/statistics" >');
                   1511:     my $content = $ENV{'form.sort'};
1.20      minaeibi 1512:     if (!($ENV{'form.showcsv'}) && 
                   1513:         ($content eq '' || $content eq 'Return to Menu')) {
1.15      minaeibi 1514: 	my $Ptr = '<h3>';
                   1515: 	$Ptr .= '<input type=submit name=sort value="Problem Stats"/>';
                   1516: 	$Ptr .= '<br><br>';
                   1517: 	$Ptr .= '<input type=submit name=sort value="Problem Analysis"/>';
                   1518: 	$Ptr .= '<br><br>';
                   1519: 	$Ptr .= '<input type=submit name=sort value="Student Assessment"/>';
                   1520: 	$Ptr .= '</h3>';
1.21      minaeibi 1521: 	#$Ptr .= '<input type=submit name=sort value="Activity Log"/>';
1.15      minaeibi 1522: 	$r->print( $Ptr );
                   1523:     }
                   1524:     else {
1.19      minaeibi 1525: 	&ClassList();
1.15      minaeibi 1526: 	if ( $content eq 'Student Assessment' || 
                   1527: 	     $content eq 'Create Student Report' ) {
                   1528: 	    &MapSecOptions();
                   1529: 	    &StudentOptions();
                   1530: 	    &StudentReport($CurStu,$StuBox{"$CurStu"});
                   1531: 	}
                   1532: 	elsif ( $content eq 'Problem Analysis' ) {
                   1533: 	    &AnalyzeProblem();
                   1534: 	}
                   1535: 	else {
                   1536: 	    &MapSecOptions();
                   1537: 	    &PreStatTable();
                   1538: 	}
                   1539:     }
1.1       albertel 1540: }
                   1541: 
                   1542: 
                   1543: sub Menu {
1.15      minaeibi 1544:     &initial();
1.26    ! minaeibi 1545: #    my $fn=$ENV{'request.course.fn'};
        !          1546: #    $r->print( '<br>'.$fn.'<br>' );
        !          1547: 
1.19      minaeibi 1548: #    $Apache::lonxml::debug=1;
                   1549: #    &Apache::lonhomework::showhash(%ENV);
                   1550: #    $Apache::lonxml::debug=0;
1.26    ! minaeibi 1551: 
1.15      minaeibi 1552:     &Title();
1.1       albertel 1553:     my $InpStr = $ENV{'form.sort'};
1.21      minaeibi 1554:     if ($InpStr eq 'Activity Log') {
                   1555: 	&Activity();
                   1556:     }    
                   1557:     elsif ($InpStr=~/^Analyze\_/) {
1.19      minaeibi 1558: 	&ClassList();
1.15      minaeibi 1559: 	&ShowOpGraph($InpStr,$ENV{'form.interval'});
                   1560:     }
                   1561:     elsif ( $InpStr eq 'DoDiff Graph' || $InpStr eq '%Wrong Graph' ) {      
1.1       albertel 1562: 	&GetGraphData($InpStr);
                   1563:     	$r->print('<IMG src="/cgi-bin/graph.gif?'.$GData.'" />');
                   1564:     }
                   1565:     else {
1.15      minaeibi 1566: 	&CreateForm();
                   1567: 	$r->print("\n".'</form>');
1.1       albertel 1568:     }
1.15      minaeibi 1569:     $r->print("\n".'</body>'.
                   1570: 	      "\n".'</html>');
                   1571:     $r->rflush();
1.1       albertel 1572: }
1.21      minaeibi 1573: 
1.1       albertel 1574: 
                   1575: sub StudentOptions {
                   1576:     my $OpSel5='';
                   1577:     $CurStu = $ENV{'form.student'};
                   1578:     if ( $CurStu eq '' ) { 
                   1579:         $CurStu = 'All Students';
                   1580:         $OpSel5 = 'selected';
                   1581:     }
                   1582:     my $Ptr ='';
                   1583: # ----------------------------------- Loading the Students Combobox
                   1584:     $Ptr .= '<br><b>Select Student</b>'."\n".
                   1585:        	    '<select name="student">'."\n". 
                   1586: 	    '<option '.$OpSel5.'>All Students</option>';                     	     	     
                   1587:     foreach my $key ( sort keys %StuBox ) {	          
                   1588: 	$Ptr .= '<option';
                   1589: 	if ($CurStu eq $key) {$Ptr .= ' selected';}     
                   1590:         $Ptr .= '>'.$key."</option>\n";	     
                   1591:     }
                   1592:     $Ptr .= '</select>';
                   1593:     $Ptr .= '<br><input type="submit" name="sort" value="Create Student Report" />';
                   1594:     $r->print( $Ptr );
                   1595:     $r->rflush();	
                   1596: }
                   1597: 
1.15      minaeibi 1598: 
1.1       albertel 1599: sub GetStatus {
                   1600:     $OpSel1='';
                   1601:     $OpSel2='';
                   1602:     $OpSel3='';
                   1603:     $OpSel4='';
                   1604: 
                   1605:     if ( $ENV{'form.order'} eq 'Descending' ) { $OpSel2='selected'; }
                   1606:     else { $OpSel1 = 'selected'; }
1.5       minaeibi 1607: 
                   1608:     my %myHeader = reverse( %Header );
                   1609:     $Pos = $myHeader{$ENV{'form.sort'}};
                   1610:     if ($Pos == 0) {
                   1611: 	$OpSel1 = 'selected';
                   1612: 	$ENV{'form.order'}='Ascendig';
                   1613:     }
                   1614: 
1.1       albertel 1615:     $CurMap = $ENV{'form.maps'};
                   1616:     if ( $CurMap eq '' ) { 
                   1617: 	$CurMap = 'All Maps';
                   1618: 	$OpSel3 = 'selected';
                   1619:     }
                   1620:     $CurSec = $ENV{'form.section'};
                   1621:     if ( $CurSec eq '' ) { 
                   1622: 	$CurSec = 'All Sections';
                   1623:         $OpSel4 = 'selected';
                   1624:     }
                   1625: }
                   1626: 
                   1627: 
                   1628: sub MapSecOptions {
                   1629: # ----------------------------------- Loading the Maps Combobox
1.19      minaeibi 1630:     my $Ptr = '<br>';
1.18      minaeibi 1631:     $Ptr .= '<input type="submit" name="sort" value="Return to Menu" />';
1.1       albertel 1632:     $Ptr .= '<br><b> Select &nbsp; Map &nbsp; &nbsp; </b>'."\n".
                   1633:        	    '<select name="maps">'."\n". 
                   1634: 	    '<option '.$OpSel3.'>All Maps</option>';                     	     	     
                   1635:     foreach my $key ( sort keys %maps ) {	          
                   1636: 	$Ptr .= '<option';
                   1637:         if ($CurMap eq $key) {$Ptr .= ' selected';}	     
                   1638: 	$Ptr .= '>'.$key."</option>\n";	     
                   1639:     }
                   1640:     $Ptr .= '</select>';
                   1641:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                   1642: 
                   1643: # ----------------------------------- Loading the Sections Combobox
                   1644:     $Ptr .= '<br><b>Select Section</b>'."\n".
                   1645:        	    '<select name="section">'."\n". 
                   1646: 	    '<option '.$OpSel4.'>All Sections</option>';                     	     	     
                   1647:     foreach my $key ( sort keys %section ) {	          
                   1648: 	$Ptr .= '<option';
                   1649:         if ($CurSec eq $key) {$Ptr .= ' selected';}     
                   1650: 	$Ptr .= '>'.$key."</option>"."\n";	     
                   1651:     }
                   1652:     $Ptr .= '</select>'."\n";
                   1653: 
                   1654:     $r->print( $Ptr );
                   1655:     $r->rflush();
                   1656: }
                   1657: 
                   1658: 
                   1659: # ================================================================ Main Handler
                   1660: 
                   1661: sub handler {
                   1662:     $r=shift;
                   1663: 
                   1664:     if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
                   1665: # ------------------------------------------- Set document type for header only
                   1666: 	if ($r->header_only) {
                   1667: 	    if ($ENV{'browser.mathml'}) {
                   1668: 		$r->content_type('text/xml');
                   1669: 	    } 
                   1670: 	    else {
                   1671: 		$r->content_type('text/html');
                   1672: 	    }
                   1673: 	    $r->send_http_header;
                   1674: 	    return OK;
                   1675: 	}    
                   1676: 	my $requrl=$r->uri;
                   1677: # ----------------------------------------------------------------- Tie db file
                   1678: 
                   1679: 	undef %hash;
                   1680: 
                   1681: 	if ($ENV{'request.course.fn'}) {
                   1682: 	    my $fn=$ENV{'request.course.fn'};
                   1683: 	    if (-e "$fn.db") {
                   1684: 		if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
                   1685: # ------------------------------------------------------------------- Hash tied
                   1686: 		    $r->content_type('text/html');
                   1687: 		    $r->send_http_header;
                   1688: 		    &Menu();
                   1689: 		}
                   1690: 		else {
                   1691: 		    $r->content_type('text/html');
                   1692: 		    $r->send_http_header;
                   1693: 		    $r->print('<html><body>Coursemap undefined.</body></html>');
                   1694: 		}
                   1695: # ------------------------------------------------------------------ Untie hash
                   1696: 		unless (untie(%hash)) {
                   1697: 		    &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                   1698:                             "Could not untie coursemap $fn (browse).</font>"); 
                   1699: 		}
                   1700: 
                   1701: # -------------------------------------------------------------------- All done
                   1702: 		return OK;
                   1703: # ----------------------------------------------- Errors, hash could no be tied
                   1704: 	    }
                   1705: 	} 
                   1706: 	else {
                   1707: 	    $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
                   1708: 	    return HTTP_NOT_ACCEPTABLE; 
                   1709: 	}
                   1710:     }
                   1711:     else {
                   1712:         $ENV{'user.error.msg'}=
                   1713:         $r->uri.":vgr:0:0:Cannot view grades for complete course";
                   1714: 
                   1715:         return HTTP_NOT_ACCEPTABLE; 
                   1716:     }
                   1717: }
                   1718: 1;
                   1719: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>