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

1.1       albertel    1: # The LearningOnline Network with CAPA
                      2: # (Publication Handler
                      3: #
1.29    ! stredwic    4: # $Id: lonstatistics.pm,v 1.28 2002/07/19 18:17:34 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.28      minaeibi   34: # 5/12,5/14,5/15,5/19,5/26,7/16  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.29    ! stredwic   45: use Apache::loncoursedata;
        !            46: use Apache::lonhtmlcommon;
        !            47: use Apache::lonchart;
1.1       albertel   48: use HTML::TokeParser;
                     49: use GDBM_File;
                     50: 
                     51: # -------------------------------------------------------------- Module Globals
                     52: my %hash;
                     53: my %CachData;
                     54: my %GraphDat;
                     55: my $r;
                     56: my $GData;
1.25      minaeibi   57: my %color;
1.15      minaeibi   58: my %foil_to_concept;
                     59: my @Concepts;
                     60: my %ConceptData;
1.28      minaeibi   61: my %Answer=();
                     62: my %mapsort;
                     63: 
                     64: my %Activity=();
                     65: my %Grade=();
                     66: my %DoDiff=();
                     67: my %Discuss=();
                     68: my $TotalDiscuss=0;
                     69: my $TotalDiscuss_=0;
                     70: 
                     71: 
                     72: sub LoadDiscussion {
                     73: #    my $symb=shift;
                     74: #    $r->print('<br>$cid ... '.$symb);
                     75: #    my %contrib=&Apache::lonnet::dump('msu_2964385f9033c63msul1','msu','2964385f9033c63msul1');
                     76:     my $cid=$ENV{'request.course.id'};
                     77:     my %contrib=&Apache::lonnet::dump(
                     78:                 $ENV{'request.course.id'},
                     79:                 $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
                     80:                 $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
                     81: 				                            
                     82:     foreach my $temp(keys %contrib) {
                     83: 	if ($temp=~/^version/) {
                     84: 	    my $ver=$contrib{$temp};
                     85: 	    my ($dummy,$prb)=split(':',$temp);
                     86: 	    for (my $idx=1; $idx<=$ver; $idx++ ) {
                     87: 		my $name=$contrib{"$idx:$prb:sendername"};
                     88: 		$Discuss{"$name:$prb"}=$idx;	
                     89: 	    }
                     90: 	}
                     91:     }       
                     92: #   $r->print('<br>cid='.$cid);
                     93: #    my %contrib=&Apache::lonnet::restore($symb,$cid,
                     94: #					 $ENV{$cid.'.domain'},
                     95: #					 $ENV{'course.'.$cid.'.num'});
                     96: 
                     97: #    $Apache::lonxml::debug=1;
                     98: #    &Apache::lonhomework::showhash(%Discuss);
                     99: #    $Apache::lonxml::debug=0;
                    100: }
                    101: 
                    102: sub LoadDoDiffFile {
                    103:     my $file="/home/minaeibi/183d.txt";
                    104:     open(FILEID, "<$file");
                    105:     my $line=<FILEID>;
                    106:     %DoDiff=();
                    107:     my @Act=split('&',$line);
                    108:     
                    109: #    $r->print('<br>'.$#Act);
                    110:     for(my $n=0;$n<=$#Act;$n++){
                    111:        my ($res,$Degree)=split('@',$Act[$n]);
                    112:       $DoDiff{$res}=$Degree;
                    113:     }
                    114: }
                    115: 
                    116: 
                    117: sub LoadClassFile {
                    118:     my $file="/home/minaeibi/class.txt";
                    119:     open(FILEID, "<$file");
                    120:     my $line;
                    121:     %Grade=();
                    122:     while ($line=<FILEID>) {
                    123:         my ($id,$ex1,$ex2,$ex3,$ex4,$hw,$final,$grade)=split(' ',$line);
                    124:         $Grade{$id}=$grade;
                    125:     }
                    126: }
                    127: 
                    128: 
                    129: #------- Classification  
                    130: sub Classify {
                    131:     my ($DiscFac, $students)=@_;
                    132:     &LoadClassFile();
                    133:     my $Count=0;
                    134:     my @List=();
                    135:     my @LS=();
                    136:     my @LF=();
                    137:     my @LM=();
                    138:     my $cf=0;
                    139:     my $cs=0;
                    140:     my $cm=0;
                    141:     foreach (keys(%$DiscFac)){  
                    142: 	my @l=split(/\:/,$_);
                    143: 	if (!($students->{$l[1]})) {next;}
                    144: 	my $Grade=$Grade{$students->{$l[1]}};
                    145: 	if( $Grade > 3 ) {
                    146: 	    $cs++;
                    147: 	    push(@LS,("$l[6],$l[5],$l[4],$l[7],$l[8],$l[9],Successful"));
                    148: 	} elsif ( $Grade > 2 ) {
                    149: 	    $cm++;
                    150: 	    push(@LM,("$l[6],$l[5],$l[4],$l[7],$l[8],$l[9],Average"));
                    151: 	} else {
                    152: 	    $cf++;
                    153: 	    push(@LF,("$l[6],$l[5],$l[4],$l[7],$l[8],$l[9],Failed"));
                    154: 	}
                    155:     }    
                    156:     for(my $n=0;$n<$cs;$n++){$r->print('<br>'.$LS[$n]);}
                    157:     for(my $n=0;$n<$cm;$n++){$r->print('<br>'.$LM[$n]);}  
                    158:     for(my $n=0;$n<$cf;$n++){$r->print('<br>'.$LF[$n]);}
                    159: } 
                    160: 
                    161: 
                    162: sub ProcAct {
                    163:     # return;
                    164:     my ($Act,$Submit)=@_;
                    165:     my @Act=split(/\@/,$Act);
                    166:     @Act = sort(@Act);
                    167: 
                    168:     ##$r->print('<br>'.$#Act);
                    169:     ##for(my $n=0;$n<=$#Act;$n++){
                    170: ##	$r->print('<br>n='.$n.')'.$Act[$n]);
                    171: ##    }
                    172: 
                    173: #    my $Beg=$Act[0];
                    174:     my $Dif=$Submit-$Act[0];
                    175:     $Dif = ($Dif>0) ? ($Dif/3600) : 0; 
                    176: 
                    177: #    $r->print('<br>Access Number = '.$#Act.'<br>Submit Time='.$Submit.'<br>First Access='.$Act[0].'<br>Last Access='.$Act[$#Act].'<br> Submit - First = <b>'.$Dif.'</b>');
                    178: 
                    179: 
                    180: #time spent for solving the problem           
                    181: #    $r->print('<br>Def'.($Act[$#Act-1]-$Act[0]));
                    182: 
                    183:     return $Dif;
                    184: }
                    185: 
                    186: 
                    187: 
                    188: sub LoadActivityLog {
                    189: #    my $CacheDB = "/home/minaeibi/act183.log.cache";
                    190:     my $CacheDB = "/home/httpd/perl/tmp/act183.log.cache";
                    191:     
                    192:     if (-e "$CacheDB") {
                    193: 	if (tie(%Activity,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) {
                    194: 	    return;
                    195:         }
                    196:         else {
                    197: 	    $r->print("Unable to tie log Cache hash to db file");
                    198:         }
                    199:     }
                    200:     else {
                    201: 	if (tie(%Activity,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) {
                    202: 	    foreach (keys %Activity) {delete $Activity{$_};}
                    203: 	    &Build_log(); 
                    204: 	}
                    205:         else {
                    206: 	    $r->print("Unable to tie log Build hash to db file");
                    207:         }
                    208:     }
                    209: }
                    210: 
                    211: sub Build_log {
                    212:     my $file="/home/minaeibi/act183.log";
                    213:     open(FILEID, "<$file");
                    214:     my $line;
                    215:     my $count=0;
                    216:     while ($line=<FILEID>) {
                    217: 	my ($time,$machine,$what)=split(':',$line);
                    218: 	$what=&Apache::lonnet::unescape($what);
                    219: 	my @accesses=split('&',$what);
                    220: 	           
                    221: 	foreach my $access (@accesses) {
                    222: 
                    223: 	    $count++;
                    224: 
                    225: 	    my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
                    226: 	    if (!$resource) { next; }
                    227: 	    my $res=&Apache::lonnet::unescape($resource);
                    228: 	    if (($res =~ /\.problem/)) {
                    229: 		$Activity{$who.':'.$res}.=$date.'@';
                    230:                 #$r->print('<br>'.$time.':'.$who.'---'.$res);
                    231: 		&Update_PrgInit($count);
                    232: 
                    233: 	    }
                    234: 	}
                    235:     }
                    236: 
                    237: # my $c=1;
                    238: # foreach (sort keys %Activity) {
                    239: #     $r->print('<br>'.$c.')'.$_.' ... '.$Activity{$_});
                    240: #     $c++;
                    241: # }
                    242: 
                    243: }
1.15      minaeibi  244: 
1.21      minaeibi  245: sub Activity {
1.28      minaeibi  246: #    $rid=~/(\d+)\.(\d+)/;
                    247: #    my $MapId=$1;
                    248: #    my $PrbId=$2;
                    249: #    my $MapOrg = $hash{'map_id_'.$MapId};
                    250: #    my $Map = &Apache::lonnet::declutter($MapOrg);
                    251: #    my $URI = $hash{'src_'.$rid};
                    252: #    my $Symb = $Map.'___'.$PrbId.'___'.&Apache::lonnet::declutter($URI);
1.26      minaeibi  253:     my $file="/home/minaeibi/activity.log";
                    254:     my $userid='adamsde1';
1.21      minaeibi  255:     $r->print("<br>Using $file");
                    256:     $r->rflush();
                    257:     open(FILEID, "<$file");
                    258:     my $line;
                    259:     my @allaccess;
1.25      minaeibi  260:     my $Count=0;
1.21      minaeibi  261:     while ($line=<FILEID>) {
                    262: 	my ($time,$machine,$what)=split(':',$line);
1.25      minaeibi  263: 	$what=&Apache::lonnet::unescape($what);
1.21      minaeibi  264: 	my @accesses=split('&',$what);
                    265: 	foreach my $access (@accesses) {
                    266: 	    my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
1.28      minaeibi  267: 	    #if ($who ne $userid) { next; }
1.25      minaeibi  268: 	    if (!$resource) { next; }
                    269: 	    my $res=&Apache::lonnet::unescape($resource);
1.28      minaeibi  270: 	    if (($res =~ /\.(sequence|problem|htm|html|page)/)) {
                    271: 	    	$Count++;
1.26      minaeibi  272: 		$r->print("<br>$Count) ".localtime($date).": $who --> $res");
                    273: #	        if ($post) { 
                    274: #		    $Count++;
                    275: #		    $r->print("<br><b>$Count) Sent data ".join(':',
                    276: #                              &Apache::lonnet::unescape(@posts)).'</b>');
                    277: #		}
1.25      minaeibi  278: 		$r->rflush();
1.26      minaeibi  279: 	    }
1.28      minaeibi  280: 	    #push (@allaccess,unescape($access));
1.21      minaeibi  281: 	    #print $machine;
                    282: 	}
                    283:     }
1.25      minaeibi  284: #    @allaccess=sort(@allaccess);
                    285: #    $Count=0;
                    286: #    foreach my $access (@allaccess) {
                    287: #	my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
                    288: #	$Count++;
                    289: #	$r->print("<br>$Count) $date: $who --> $resource");
                    290: #	$r->rflush();
                    291: #	if ($post) { 
                    292: #	    $r->print("<br><b>Sent data ".join(':',unescape(@posts)).'</b>');
                    293: #	}
                    294: #    }
1.21      minaeibi  295: }
                    296: 
                    297: 
1.27      stredwic  298: sub InitAnalysis {
                    299:     my ($uri,$part,$problem,$student,$courseID)=@_;
1.28      minaeibi  300:     my ($uname,$udom)=split(/\:/,$student);
                    301: 
1.21      minaeibi  302: 
1.27      stredwic  303:     # Render the student's view of the problem.  $Answ is the problem 
                    304:     # Stringafied
1.28      minaeibi  305:     my $Answ=&Apache::lonnet::ssi($uri,('grade_target' => 'analyze',
                    306:                                   'grade_username' => $uname,
                    307:                                   'grade_domain' => $udom,
                    308:                                   'grade_courseid' => $courseID,
                    309:                                   'grade_symb' => $problem));
                    310: #    my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze'));
1.15      minaeibi  311: 
1.28      minaeibi  312: #    (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
1.18      minaeibi  313:     %Answer=();
1.15      minaeibi  314:     %Answer=&Apache::lonnet::str2hash($Answ);
                    315: 
                    316:     my $parts='';
                    317:     foreach my $elm (@{$Answer{"parts"}}) {
                    318: 	$parts.="$elm,";
                    319:     }
                    320:     chop($parts);
                    321:     my $conc='';
                    322:     foreach my $elm (@{$Answer{"$parts.concepts"}}) {
                    323: 	$conc.="$elm@";
                    324:     }
                    325:     chop($conc);
                    326: 
                    327:     @Concepts=split(/\@/,$conc);
                    328:     foreach my $concept (@{$Answer{"$parts.concepts"}}) {
                    329: 	foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
                    330: 	    $foil_to_concept{$foil} = $concept;
1.19      minaeibi  331: 	    #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
1.15      minaeibi  332: 	}
                    333:     }
1.27      stredwic  334: 
                    335:     return;
1.15      minaeibi  336: }
                    337: 
1.28      minaeibi  338: 
1.15      minaeibi  339: sub Interval {
1.27      stredwic  340:     my ($part,$symb)=@_;
1.28      minaeibi  341:     my $Int=$ConceptData{"Interval"};
                    342:     my $due = &Apache::lonnet::EXT('resource.$part.duedate',$symb)+1;
                    343:     my $opn = &Apache::lonnet::EXT('resource.$part.opendate',$symb);
                    344:     my $add=int(($due-$opn)/$Int);
                    345:     $ConceptData{"Int.0"}=$opn;
                    346:     for (my $i=1;$i<$Int;$i++) {
                    347: 	$ConceptData{"Int.$i"}=$opn+$i*$add;
1.15      minaeibi  348:     }
1.28      minaeibi  349:     $ConceptData{"Int.$Int"}=$due;     
                    350:     for (my $i=0;$i<$Int;$i++) {
1.15      minaeibi  351: 	for (my $n=0; $n<=$#Concepts; $n++ ) {
                    352: 	    my $tmp=$Concepts[$n];
1.28      minaeibi  353: 	    $ConceptData{"$tmp.$i.true"}=0;
                    354: 	    $ConceptData{"$tmp.$i.false"}=0;
1.15      minaeibi  355: 	}
                    356:     }
                    357: }
                    358: 
1.28      minaeibi  359: 
1.27      stredwic  360: sub ShowOpGraph {
                    361:     my ($cache, $students, $courseID)=@_;
                    362:     my $uri      = $cache->{'AnalyzeURI'};
                    363:     my $part     = $cache->{'AnalyzePart'};
                    364:     my $problem  = $cache->{'AnalyzeProblem'};
1.28      minaeibi  365:     my $title    = $cache->{'AnalyzeTitle'};
1.27      stredwic  366:     my $interval = $cache->{'Interval'};
                    367:     $ConceptData{"Interval"} = $interval;
1.15      minaeibi  368: 
1.19      minaeibi  369:     #Initialize the option response true answers
1.27      stredwic  370:     &InitAnalysis($uri, $part, $problem, $students->[0],$courseID);
                    371: 
1.19      minaeibi  372:     #compute the intervals
1.27      stredwic  373:     &Interval($part,$problem);
                    374: 
                    375:     $title =~ s/\ /"_"/eg;
                    376:     $r->print('<br><b>'.$uri.'</b>');
1.15      minaeibi  377:     $r->rflush();
1.28      minaeibi  378:          
1.19      minaeibi  379:     #Java script Progress window
1.16      minaeibi  380:     &Create_PrgWin();
1.28      minaeibi  381:     &Update_PrgWin("Starting-to-analyze-problem");
                    382:     for (my $index=0;$index<(scalar @$students);$index++) {
                    383: 	&Update_PrgWin($index);
                    384: 	&OpStatus($problem,$students->[$index],$courseID);
1.15      minaeibi  385:     }
                    386:     &Close_PrgWin();
                    387: 
1.19      minaeibi  388:     $r->print('<br>');
1.28      minaeibi  389:     for (my $k=0; $k<$interval; $k++ ) {
1.27      stredwic  390: 	&DrawGraph($k,$title);
1.15      minaeibi  391:     }
1.28      minaeibi  392:     for (my $k=0; $k<$interval; $k++ ) {
1.20      minaeibi  393: 	&DrawTable($k);
                    394:     }
1.17      minaeibi  395: #$Apache::lonxml::debug=1;
                    396: #&Apache::lonhomework::showhash(%ConceptData);
                    397: #$Apache::lonxml::debug=0;
1.27      stredwic  398:     my $Answ=&Apache::lonnet::ssi($uri);
1.15      minaeibi  399:     $r->print("<br><b>Here you can see the Problem:</b><br>$Answ");
                    400: }
                    401: 
1.28      minaeibi  402: 
1.20      minaeibi  403: sub DrawTable {
                    404:     my $k=shift;
1.15      minaeibi  405:     my $Max=0;
                    406:     my @data1;
                    407:     my @data2;
1.18      minaeibi  408:     my $Correct=0;
                    409:     my $Wrong=0;
1.15      minaeibi  410:     for (my $n=0; $n<=$#Concepts; $n++ ) {
                    411: 	my $tmp=$Concepts[$n];
                    412: 	$data1[$n]=$ConceptData{"$tmp.$k.true"};
1.18      minaeibi  413: 	$Correct+=$data1[$n];
1.15      minaeibi  414: 	$data2[$n]=$ConceptData{"$tmp.$k.false"};
1.18      minaeibi  415: 	$Wrong+=$data2[$n];
1.15      minaeibi  416: 	my $Sum=$data1[$n]+$data2[$n];
                    417: 	if ( $Max<$Sum ) {$Max=$Sum;}
                    418:     }
                    419:     for (my $n=0; $n<=$#Concepts; $n++ ) {
                    420: 	if ($data1[$n]+$data2[$n]<$Max) {
                    421: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
                    422: 	}
                    423:     }
1.18      minaeibi  424:     my $P_No = $#data1+1;
                    425: #    $r->print('<br><b>From: ['.localtime($ConceptData{'Int.'.($k-1)}).
                    426: #              '] To: ['.localtime($ConceptData{"Int.$k"}).']</b>'); 
                    427:     my $Str = "\n".'<table border=2>'.
                    428:               "\n".'<tr>'.
                    429:               "\n".'<th> # </th>'.
                    430: 	      "\n".'<th> Concept </th>'.
                    431: 	      "\n".'<th> Correct </th>'.
                    432: 	      "\n".'<th> Wrong </th>'.
                    433: 	      "\n".'</tr>';
1.15      minaeibi  434: 
1.18      minaeibi  435:     for (my $n=0; $n<=$#Concepts; $n++ ) {
                    436: 	$Str .= "\n"."<tr>".
                    437: 	        "\n"."<td>".($n+1)."</td>".
1.25      minaeibi  438:                 "\n".'<td bgcolor='.$color{"yellow"}.'> '.$Concepts[$n]." </td>".
                    439:                 "\n".'<td bgcolor='.$color{"green"}.'> '.$data1[$n]." </td>".
                    440:                 "\n".'<td bgcolor='.$color{"red"}.'> '.$data2[$n]." </td>".
1.18      minaeibi  441:                 "\n"."</tr>";
                    442:     }
1.20      minaeibi  443:     $Str.='<td></td><td><b>From:['.localtime($ConceptData{'Int.'.$k}).
                    444:           '] To: ['.localtime($ConceptData{'Int.'.($k+1)}-1).
                    445:           "]</b></td><td>$Correct</td><td>$Wrong</td>";
                    446: 
                    447:     $Str .= "\n".'</table>';
                    448: 
                    449:     $r->print($Str);
1.19      minaeibi  450: #$Apache::lonxml::debug=1;
                    451: #&Apache::lonhomework::showhash(%ConceptData);
                    452: #$Apache::lonxml::debug=0;
1.20      minaeibi  453: }
1.19      minaeibi  454: 
1.15      minaeibi  455: 
1.20      minaeibi  456: sub DrawGraph {
1.28      minaeibi  457:     my ($k,$Src)=@_;
1.20      minaeibi  458:     my $Max=0;
                    459:     my @data1;
                    460:     my @data2;
1.15      minaeibi  461: 
1.20      minaeibi  462:     # Adjust Data and find the Max 
1.28      minaeibi  463:     for (my $n=0; $n<=$#Concepts; $n++ ) {
1.20      minaeibi  464: 	my $tmp=$Concepts[$n];
1.28      minaeibi  465: 	$data1[$n]=$ConceptData{"$tmp.$k.true"};
                    466: 	$data2[$n]=$ConceptData{"$tmp.$k.false"};
1.20      minaeibi  467: 	my $Sum=$data1[$n]+$data2[$n];
1.28      minaeibi  468: 	if ( $Max<$Sum ) {$Max=$Sum;}
1.20      minaeibi  469:     }
1.28      minaeibi  470:     for (my $n=0; $n<=$#Concepts; $n++ ) {
                    471: 	if ($data1[$n]+$data2[$n]<$Max) {
1.20      minaeibi  472: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
                    473: 	}
                    474:     }
1.28      minaeibi  475:     my $P_No = $#data1+1;
1.18      minaeibi  476: 
1.28      minaeibi  477:     if ( $Max > 1 ) { 
1.18      minaeibi  478: 	$Max += (10 - $Max % 10);
                    479: 	$Max = int($Max);
1.28      minaeibi  480:     } else { $Max = 1; }
1.18      minaeibi  481: 
1.28      minaeibi  482:     my $Titr=($ConceptData{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
1.18      minaeibi  483: #    $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
1.28      minaeibi  484:     $GData="$Titr&Concepts&Answers&$Max&$P_No&".
                    485:            (join(',',@data1)).'&'.(join(',',@data2));
1.18      minaeibi  486: 
1.19      minaeibi  487:     $r->print('<IMG src="/cgi-bin/graph.gif?'.$GData.'" border=1/>');
1.15      minaeibi  488: }
                    489: 
                    490: 
                    491: sub Decide {
1.19      minaeibi  492:     #deciding the true or false answer belongs to each interval
1.15      minaeibi  493:     my ($type,$foil,$time)=@_; 
                    494:     my $k=0;
                    495:     while ($time>$ConceptData{'Int.'.($k+1)} && 
                    496:            $k<$ConceptData{'Interval'}) {$k++;}
                    497:     $ConceptData{"$foil_to_concept{$foil}.$k.$type"}++;
                    498: }
                    499: 
1.19      minaeibi  500: #restore the student submissions and finding the result
1.15      minaeibi  501: sub OpStatus {
1.27      stredwic  502:     my ($problem, $student, $courseID)=@_;
                    503:     my ($username,$userdomain)=split(/':'/,$student);
1.15      minaeibi  504:     my $code='U';
1.27      stredwic  505:     my %reshash=&Apache::lonnet::restore($problem, $courseID, $userdomain, 
                    506:                                          $username);
1.15      minaeibi  507:     my @True = ();
                    508:     my @False = ();
                    509:     my $flag=0;
                    510:     if ($reshash{'version'}) {
1.18      minaeibi  511:         my $tries=0;
                    512: 	&Apache::lonhomework::showhash(%Answer);
1.15      minaeibi  513: 	for (my $version=1;$version<=$reshash{'version'};$version++) {
                    514: 	    my $time=$reshash{"$version:timestamp"};
1.18      minaeibi  515: 	   
                    516: 	    foreach my $key (sort(split(/\:/,$reshash{$version.':keys'}))) {
                    517: 		if (($key=~/\.(\w+)\.(\w+)\.submission$/)) {
                    518: 		    my $Id1 = $1; my $Id2 = $2;
                    519: 		    #check if this is a repeat submission, if so skip it
                    520:           	    if ($reshash{"$version:resource.$Id1.previous"}) { next; }
                    521: 		    #if no solved this wasn't a real submission, ignore it
                    522: 		    if (!defined($reshash{"$version:resource.$Id1.solved"})) {
                    523: 			&Apache::lonxml::debug("skipping ");
                    524: 			next;
                    525: 		    }
                    526: 		    my $Resp = $reshash{"$version:$key"};
1.15      minaeibi  527: 		    my %submission=&Apache::lonnet::str2hash($Resp);
                    528: 		    foreach (keys %submission) {
1.18      minaeibi  529: 			my $Ansr = $Answer{"$Id1.$Id2.foil.value.$_"};
1.15      minaeibi  530: 			if ($submission{$_}) {
                    531: 			    if ($submission{$_} eq $Ansr) {
                    532: 				&Decide("true",$_,$time );
                    533: 			    }
                    534: 			    else {&Decide("false",$_,$time );}
                    535: 			}
                    536: 		    }
                    537: 	        }	  
                    538: 	    }
                    539:         }
                    540:     }
                    541: }
1.11      minaeibi  542: 
1.28      minaeibi  543: 
1.27      stredwic  544: #---- END Analyze Web Page ----------------------------------------------
                    545: 
                    546: #---- Problem Statistics Web Page ---------------------------------------
1.11      minaeibi  547: 
1.7       minaeibi  548: #------- Processing upperlist and lowerlist according to each problem
1.27      stredwic  549: sub ProcessDiscriminant {
                    550:     my ($List) = @_;
                    551:     my @sortedList = sort (@$List);
                    552:     my $Count = scalar @sortedList;
                    553:     my $Problem;
1.7       minaeibi  554:     my @Dis;
                    555:     my $Slvd=0;
                    556:     my $tmp;
1.8       minaeibi  557:     my $Sum1=0;
                    558:     my $Sum2=0;
1.27      stredwic  559:     my $nIndex=0;
                    560:     my $nStudent=0;
                    561:     my %Proc=undef;
                    562:     while ($nIndex<$Count) {
                    563: 	($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]);
1.7       minaeibi  564: 	@Dis=split(/\+/,$tmp);
1.27      stredwic  565: 	my $Temp = $Problem;
1.7       minaeibi  566: 	do {
1.27      stredwic  567: 	    $nIndex++;
                    568: 	    $nStudent++;
1.8       minaeibi  569: 	    $Sum1 += $Dis[0];
                    570: 	    $Sum2 += $Dis[1];
1.27      stredwic  571: 	    ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]);
1.7       minaeibi  572: 	    @Dis=split(/\+/,$tmp);
1.27      stredwic  573: 	} while ( $Problem eq $Temp && $nIndex < $Count );
                    574: #	$Proc{$Temp}=($Sum1/$nStudent).':'.$nStudent;
                    575: 	$Proc{$Temp}=($Sum1/$nStudent).':'.($Sum2/$nStudent);
                    576: #       $r->print("$nIndex) $Temp --> ($nStudent) $Proc{$Temp} <br>");
1.8       minaeibi  577: 	$Sum1=0;
                    578: 	$Sum2=0;
1.27      stredwic  579: 	$nStudent=0;
1.7       minaeibi  580:     }
1.27      stredwic  581: 
1.7       minaeibi  582:     return %Proc;
                    583: }
                    584: 
                    585: 
1.28      minaeibi  586: 
1.7       minaeibi  587: #------- Creating Discimination factor   
                    588: sub Discriminant {
1.27      stredwic  589:     my ($discriminantFactor)=@_;
                    590:     my @discriminantKeys=keys(%$discriminantFactor);
                    591:     my $Count = scalar @discriminantKeys;
                    592: 
                    593:     my $UpCnt = int(0.27*$Count);
1.7       minaeibi  594:     my $low=0;
                    595:     my $up=$Count-$UpCnt;
                    596:     my @UpList=();
                    597:     my @LowList=();
1.27      stredwic  598: 
1.7       minaeibi  599:     $Count=0;
1.27      stredwic  600:     foreach my $key (sort(@discriminantKeys)) { 
1.7       minaeibi  601: 	$Count++;    
1.27      stredwic  602: 	if($low < $UpCnt || $Count > $up) {
                    603:             $low++;
                    604:             my $str=$discriminantFactor->{$key};
                    605:             foreach(split(/\:/,$str)){
                    606:                 if($_) {
                    607:                     if($low<$UpCnt) { push(@LowList,$_); }
                    608:                     else            { push(@UpList,$_);  }
                    609:                 }
                    610:             }
                    611:         }
1.7       minaeibi  612:     }
1.27      stredwic  613:     my %DisUp =  &ProcessDiscriminant(\@UpList);
                    614:     my %DisLow = &ProcessDiscriminant(\@LowList);
                    615: 
                    616:     return (\%DisUp, \%DisLow);
1.7       minaeibi  617: }
                    618: 
1.28      minaeibi  619:    
1.1       albertel  620: sub NumericSort {          
                    621:     $a <=> $b;
                    622: }
                    623: 
1.28      minaeibi  624: 
1.27      stredwic  625: sub CreateProblemStatisticsTableHeading {
                    626:     my ($displayFormat,$sequenceSource,$sequenceTitle,$headings)=@_;
                    627:     if($displayFormat eq 'Display CSV Format') {
                    628:         $r->print('<br>"'.$sequenceTitle.'","');
                    629:         $r->print($sequenceSource.'"');
1.1       albertel  630: 	return;
                    631:     }
                    632: 
1.27      stredwic  633:     $r->print('<br><a href="'.$sequenceSource.
                    634:               '" target="_blank">'.$sequenceTitle.'</a>');
1.1       albertel  635: 
1.27      stredwic  636:     my $Result = "\n".'<table border=2><tr><th>P#</th>'."\n";
                    637:     for(my $nIndex=0; $nIndex < (scalar (keys %$headings)); $nIndex++) { 
                    638: 	$Result .= '<th>'.'<input type="submit" name="';
                    639:         $Result .= 'ProblemStatisticsHeading" value="';
                    640:         $Result .= $headings->{$nIndex}.'" />'.'</th>'."\n";
1.5       minaeibi  641:     }
                    642:     $Result .= "\n".'</tr>'."\n";    
1.27      stredwic  643:     $r->print($Result);
1.5       minaeibi  644:     $r->rflush();
                    645: }
1.1       albertel  646: 
1.5       minaeibi  647: sub CloseTable {
1.27      stredwic  648:     my ($cache)=@_;
                    649:     if($cache->{'DisplayFormat'} eq 'Display CSV Format') {
1.18      minaeibi  650: 	return;
                    651:     }    
1.5       minaeibi  652:     $r->print("\n".'</table>'."\n");
                    653:     $r->rflush();
                    654: }
1.19      minaeibi  655: 
1.28      minaeibi  656: 
                    657:  
1.27      stredwic  658: # ------ Dump the Student's DB file and handling the data for statistics table 
                    659: sub ExtractStudentData {
1.28      minaeibi  660:     my ($cache,$name,$list)=@_;
1.27      stredwic  661:     my %discriminantFactor;
                    662: 
                    663:     my $totalTries = 0;
                    664:     my $totalAwarded = 0;
                    665:     my $tempProblemOrder=0;
1.28      minaeibi  666:     my $spent=0;
                    667:     my $spent_yes=0;
                    668:     my $TotDiscuss=0;
                    669:     my $TotalOpend = 0;
                    670:     my $ProbSolved = 0;
                    671:     my $ProbTot = 0;
                    672:     my $TotFirst = 0;
                    673:     my $TimeTot = 0;
                    674:     my $Discussed=0;
                    675: 
1.27      stredwic  676:     foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
                    677:         if($cache->{'ProblemStatisticsMap'} ne 'All Maps'  &&
                    678:            $cache->{'ProblemStatisticsMap'} ne $cache->{$sequence.':title'}) {
                    679:             next;
1.1       albertel  680:         }
1.12      minaeibi  681: 
1.27      stredwic  682:         my $Dis = '';
                    683:         foreach my $problemID (split(':', $cache->{$sequence.':problems'})) {
                    684:             my $problem = $cache->{$problemID.':problem'};
                    685:             my $LatestVersion = $cache->{$name.':version:'.$problem};
                    686: 
                    687:             # Output dashes for all the parts of this problem if there
                    688:             # is no version information about the current problem.
                    689:             #if(!$LatestVersion) {
                    690:             #    foreach my $part (split(/\:/,$cache->{$sequence.':'.
                    691:             #                                          $problemID.
                    692:             #                                          ':parts'})) {
                    693:             #        $codes    .= "-,";
                    694:             #        $attempts .= "0,"; 
                    695:             #    }
                    696:             #    next;
                    697:             #}
                    698: 
                    699:             my %partData=undef;
                    700:             # Initialize part data, display skips correctly
                    701:             # Skip refers to when a student made no submissions on that
                    702:             # part/problem.
                    703:             foreach my $part (split(/\:/,$cache->{$sequence.':'.
                    704:                                                   $problemID.
                    705:                                                   ':parts'})) {
                    706:                 $partData{$part.':tries'}=0;
                    707:                 $partData{$part.':code'}='-';
                    708:             }
1.1       albertel  709: 
1.27      stredwic  710:             # Looping through all the versions of each part, starting with the
                    711:             # oldest version.  Basically, it gets the most recent 
                    712:             # set of grade data for each part.
                    713: 	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
                    714:                 foreach my $part (split(/\:/,$cache->{$sequence.':'.
                    715:                                                       $problemID.
                    716:                                                       ':parts'})) {
                    717: 
                    718:                     if(!defined($cache->{$name.":$Version:$problem".
                    719:                                                ":resource.$part.solved"})) {
                    720:                         # No grade for this submission, so skip
                    721:                         next;
                    722:                     }
                    723: 
                    724:                     my $tries=0;
                    725:                     my $time=0;
                    726:                     my $awarded=0;
1.28      minaeibi  727: 		    $Discussed=0;
1.27      stredwic  728:                     my $code='U';
                    729: 
                    730:                     $awarded = $cache->{$name.
                    731:                                         "$Version:$problem:resource.".
                    732:                                         "$part.awarded"};
                    733:                     $partData{$part.':awarded'} = ($awarded) ? $awarded : 0;
                    734:                     $totalAwarded += $awarded;
                    735: 
                    736:                     $tries = $cache->{$name.":$Version:$problem".
                    737:                                       ":resource.$part.tries"};
                    738:                     $partData{$part.':tries'} = ($tries) ? $tries : 0;
                    739:                     $partData{$part.':wrong'} = $partData{$part.':tries'};
                    740:                     $totalTries += $tries;
                    741: 
                    742:                     my $val = $cache->{$name.":$Version:$problem".
                    743:                                        ":resource.$part.solved"};
                    744:                     if    ($val eq 'correct_by_student')   {$code = 'C';} 
                    745:                     elsif ($val eq 'correct_by_override')  {$code = 'O';}
                    746:                     elsif ($val eq 'incorrect_attempted')  {$code = 'I';} 
                    747:                     elsif ($val eq 'incorrect_by_override'){$code = 'I';}
                    748:                     elsif ($val eq 'excused')              {$code = 'x';}
                    749:                     $partData{$part.':code'}=$code;
                    750: 
                    751:                     if($partData{$part.':wrong'} ne 0 && 
                    752:                        ($code eq 'C' || $code eq 'O')) {
                    753:                         $partData{$part.':wrong'}--;
                    754:                     }
                    755:                 }
                    756:             }
1.1       albertel  757: 
1.27      stredwic  758:             # Loop through all the parts for the current problem in the 
                    759:             # correct order and prepare the output
                    760:             foreach (split(/\:/,$cache->{$sequence.':'.$problemID.
                    761:                                          ':parts'})) {
                    762:                 my $Yes = 0;
                    763:                 if($partData{$_.':code'} eq 'C' || 
                    764:                    $partData{$_.':code'} eq 'O') {
                    765:                     $Yes=1;
                    766:                 }
                    767:                 #my $ptr = "$hash{'title_'.$ResId}";
                    768:                 my $ptr = $tempProblemOrder.'&'.$problemID;
1.1       albertel  769: 
1.27      stredwic  770:                 if($_ > 1) {
                    771:                     $ptr .= "*(part $_)";
                    772:                     $Dis .= '&';
                    773:                 }
1.28      minaeibi  774: 
                    775: 		my ($pr_no,$dod)=split('&',$ptr);
                    776: 		my $DoDiff=$DoDiff{$dod};
                    777: #               $r->print('<br>'.$name.'---'.$ptr.'==='.$DoDiff);
                    778: 
1.27      stredwic  779:                 my $Fac = ($partData{$_.':Tries'}) ? 
                    780:                     ($partData{$_.':awarded'}/$partData{$_.':tries'}) : 0;
                    781:                 my $DisF;
                    782:                 if($Fac > 0 &&  $Fac < 1) { 
                    783:                     $DisF = sprintf( "%.4f", $Fac );
                    784:                 } else {
                    785:                     $DisF = $Fac;
                    786:                 }
1.28      minaeibi  787: 
                    788:                 if ($Discuss{"$name:$problem"}) {
                    789: 		    $TotDiscuss++;
                    790:                     $Discussed=1;
                    791:                 }
                    792:                 my $time = $cache->{"$name:$LatestVersion:$problem:timestamp"};
1.27      stredwic  793:                 $Dis .= $tempProblemOrder.'='.$DisF.'+'.$Yes;
                    794:                 $ptr .= '&'.$partData{$_.'.Tries'}.
                    795:                         '&'.$partData{$_.'.Wrongs'}.
                    796:                         '&'.$partData{$_.'.Code'};
1.28      minaeibi  797:                 push (@$list, $ptr."&$Discussed");
                    798: 
                    799: ####		if ($DoDiff>0.85) {
                    800: 
                    801:                 $TimeTot += $time;
                    802: 
                    803:                 if ($Yes==1 && $partData{$_.'.Tries'}==1) {
                    804: 		    $TotFirst++;
                    805:                 }
                    806: 		my $Acts= $Activity{$name.':'.$problem};
                    807: 		if ($Acts) {
                    808: 		    my $Pt=&ProcAct( $Acts, $time );
                    809: 		    #my ($spe,$beg) = split(/\+/,$Pt);
                    810:                     my $spe= $Pt;
                    811: 		    if ($Yes==1) {$spent_yes += $spe;}
                    812: 		    $spent += $spe;
                    813: 		    #$Beg += $beg;
                    814: #                   $r->print('<br>'.$name.'---'.$problem.'---'.$spe);
                    815: 		}
                    816: 		$TotalOpend++;
                    817: 		$ProbTot++;
                    818: 
1.27      stredwic  819:                 $tempProblemOrder++;
1.5       minaeibi  820:             }
1.1       albertel  821:         }
1.28      minaeibi  822: 	my $pstr;
1.27      stredwic  823:         if($totalTries) {
                    824: 	    my $DisFac = ($totalAwarded/$totalTries);
1.1       albertel  825: 	    my $DisFactor = sprintf( "%.4f", $DisFac );
1.28      minaeibi  826:             my $TS = sprintf( "%.2f", $spent );
                    827:             my $TS_yes = sprintf( "%.2f", $spent_yes );
                    828: 	   # $DiscFac{$DisFactor}=$Dis;
                    829: 	    $pstr=$DisFactor.':'.$name.':'.$ProbTot.':'.$TotalOpend.':'.
                    830:                   $totalTries.':'.$ProbSolved.':'.$TotFirst.':'.
                    831:                   $TS_yes.':'.$TS.':'.$TotDiscuss;
                    832: 	    $discriminantFactor{$pstr}=$Dis;
1.1       albertel  833: 	}
                    834:     }
                    835: 
1.28      minaeibi  836:     return (\%discriminantFactor);
1.1       albertel  837: }
                    838: 
1.28      minaeibi  839: 
                    840: =pod
1.1       albertel  841: sub MySort {          
1.6       minaeibi  842:     if ( $Pos > 0 ) {
1.1       albertel  843: 	if ($ENV{'form.order'} eq 'Descending') {$b <=> $a;}
                    844: 	else { $a <=> $b; }
                    845:     }
                    846:     else {
                    847: 	if ($ENV{'form.order'} eq 'Descending') {$b cmp $a;}
                    848: 	else { $a cmp $b; }
                    849:     }
                    850: }
1.28      minaeibi  851: =cut
1.1       albertel  852: 
1.27      stredwic  853: sub BuildStatisticsTable {
1.28      minaeibi  854:     my ($cache,$discriminantFactor,$list,$headings,$students)=@_;
                    855: 
                    856: #6666666
                    857: #    my $file="/home/httpd/perl/tmp/183d.txt";
                    858: #    open(OUT, ">$file");
                    859: #6666666
                    860:     &Create_PrgWin();
                    861: ##777777
                    862: ##    &LoadActivityLog();
                    863: ##    $r->print('<script>popwin.document.popremain.remaining.value="'.
                    864: ##              'Loading Discussion...";</script>');
                    865: ##    &LoadDoDiffFile();
                    866:     &LoadDiscussion();
1.1       albertel  867: 
1.27      stredwic  868:     my $p_count = 0;
                    869:     my $nIndex = 0;
                    870:     my $dummy;
                    871:     my $p_val;
                    872:     my $ResId;
                    873:     my $NoElements = scalar @$list;
1.15      minaeibi  874: 
1.27      stredwic  875:     foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
                    876:         if($cache->{'ProblemStatisticsMap'} ne 'All Maps'  &&
                    877:            $cache->{'ProblemStatisticsMap'} ne $cache->{$sequence.':title'}) {
                    878:             next;
                    879:         }
1.15      minaeibi  880: 
1.27      stredwic  881: 	&CreateProblemStatisticsTableHeading($cache->{'DisplayFormat'},
                    882:                                              $cache->{$sequence.':source'}, 
                    883:                                              $cache->{$sequence.':title'},
                    884:                                              $headings);
1.28      minaeibi  885: 
                    886: ##777777
                    887: ##    &Classify($discriminantFactor, $students);
                    888: 
                    889: 
1.5       minaeibi  890: 	my ($Hid,$pr)=split(/\:/,$mapsort{$_});
                    891: 	my @lpr=split(/\&/,$pr);
                    892: 	for (my $i=1; $i<=$#lpr; $i++) {
                    893: 	    my %storestats=();
1.28      minaeibi  894: 	    my ($PrOrd,$Prob,$Tries,$Wrongs,$Code,$Disc)=split(/\&/,$list->[$nIndex]);
1.5       minaeibi  895: 	    my $Temp = $Prob;
                    896: 	    my $MxTries = 0;
                    897: 	    my $TotalTries = 0;
                    898: 	    my $YES = 0;
                    899: 	    my $Incorrect = 0;
                    900: 	    my $Override = 0;
                    901: 	    my $StdNo = 0;
1.28      minaeibi  902: 	    my $DiscNo=0;
1.5       minaeibi  903: 	    my @StdLst;
                    904: 	    while ( $PrOrd == $lpr[$i] ) 
                    905: 	    {
1.27      stredwic  906: 		$nIndex++;
1.5       minaeibi  907: 		$StdNo++;
                    908: 		$StdLst[ $StdNo ] = $Tries;
                    909: 		$TotalTries += $Tries;
                    910: 		if ( $MxTries < $Tries ) { $MxTries = $Tries; } 
                    911: 		if ( $Code eq 'C' ){ $YES++; }
                    912: 		elsif( $Code eq 'I' ) { $Incorrect++; }
                    913: 		elsif( $Code eq 'O' ) { $Override++; }
                    914: 		elsif( $Code eq 'U' ) { $StdNo--; }
1.28      minaeibi  915: 		($PrOrd,$Prob,$Tries,$Wrongs,$Code,$Disc)=split(/\&/,$list->[$nIndex]);
1.5       minaeibi  916: 	    }	
                    917: 
                    918: 	    $p_count++;
                    919: 	    my $Dummy;
                    920: 	    ($ResId,$Dummy)=split(/\*/,$Temp);
1.1       albertel  921: 
1.5       minaeibi  922: 	    $Temp = '<a href="'.$hash{'src_'.$ResId}.
                    923:                 '" target="_blank">'.$hash{'title_'.$ResId}.$Dummy.'</a>';
1.15      minaeibi  924: 
1.5       minaeibi  925: 	    my $res = &Apache::lonnet::declutter($hash{'src_'.$ResId});
                    926: 	    my $urlres=$res;
1.1       albertel  927: 
1.5       minaeibi  928: 	    $ResId=~/(\d+)\.(\d+)/;
                    929: 	    my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
                    930: 	    $urlres=$Map;
1.1       albertel  931:  
1.5       minaeibi  932: 	    $res = '<a href="'.$hash{'src_'.$ResId}.'">'.$res.'</a>';
                    933: 	    #$Map = '<a href="'.$Map.'">'.$res.'</a>';
1.1       albertel  934: 
                    935: #------------------------ Compute the Average of Tries about one problem
1.5       minaeibi  936: 	    my $Average = ($StdNo) ? $TotalTries/$StdNo : 0;
1.1       albertel  937: 
1.5       minaeibi  938: 	    $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___timestamp'}=time;       
                    939: 	    $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___stdno'}=$StdNo;
                    940: 	    $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___avetries'}=$Average;
1.1       albertel  941:    
                    942: #-------------------------------- Compute percentage of Wrong tries
1.5       minaeibi  943: 	    my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0;
1.1       albertel  944: 
                    945: #-------------------------------- Compute Standard Deviation
1.5       minaeibi  946: 	    my $StdDev = 0; 
                    947: 	    if ( $StdNo > 1 ) {
                    948: 		for ( my $n = 0; $n < $StdNo; $n++ ) {
                    949: 		    my $Dif = $StdLst[ $n ]-$Average;
                    950: 		    $StdDev += $Dif*$Dif;
                    951: 		} 
                    952: 		$StdDev /= ( $StdNo - 1 );
                    953: 		$StdDev = sqrt( $StdDev );
                    954: 	    }
1.1       albertel  955: 
                    956: #-------------------------------- Compute Degree of Difficulty
1.5       minaeibi  957: 	    my $DoDiff = 0;
                    958: 	    if( $TotalTries > 0 ) {
                    959: 		$DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries );
1.1       albertel  960: #	    $DoDiff =  ($TotalTries)/($YES + $Override+ 0.1);	    
1.5       minaeibi  961: 	    }
1.1       albertel  962:        
1.5       minaeibi  963: 	    $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff;
1.1       albertel  964: 
                    965: #-------------------------------- Compute the Skewness
1.5       minaeibi  966: 	    my $Skewness = 0;
                    967: 	    my $Sum = 0; 
                    968: 	    if ( $StdNo > 0 && $StdDev > 0 ) {
                    969: 		for ( my $n = 0; $n < $StdNo; $n++ ) {
                    970: 		    my $Dif = $StdLst[ $n ]-$Average;
                    971: 		    $Skewness += $Dif*$Dif*$Dif;
                    972: 		} 
                    973: 		$Skewness /= $StdNo;
1.15      minaeibi  974: 		$Skewness /= $StdDev*$StdDev*$StdDev;
1.5       minaeibi  975: 	    }
1.7       minaeibi  976: 
                    977: #--------------------- Compute the Discrimination Factors
1.27      stredwic  978:             my ($Up1,$Up2)=split(/\:/,':');#jason$DisUp->{$lpr[$i]});
                    979: 	    my ($Lw1,$Lw2)=split(/\:/,':');#jason$DisLow->{$lpr[$i]});
1.8       minaeibi  980: 	    my $Dis1 = $Up1 - $Lw1;
                    981: 	    my $Dis2 = $Up2 - $Lw2;
                    982: 	    my $_D1 = sprintf("%.2f", $Dis1);
                    983: 	    my $_D2 = sprintf("%.2f", $Dis2);
1.7       minaeibi  984: 
1.1       albertel  985: #-----------------  Some restition in presenting the float numbers
1.5       minaeibi  986: 	    my $Avg = sprintf( "%.2f", $Average );
                    987: 	    my $Wrng = sprintf( "%.1f", $Wrong );
                    988: 	    my $SD = sprintf( "%.1f", $StdDev );
                    989: 	    my $DoD = sprintf( "%.2f", $DoDiff );
                    990: 	    my $Sk = sprintf( "%.1f", $Skewness );
1.15      minaeibi  991: 	    my $join = $lpr[$i].'&'.$Temp.'&'.$StdNo.'&'.
1.12      minaeibi  992:                        $TotalTries.'&'.$MxTries.'&'.$Avg.'&'.
                    993:                        $YES.'&'.$Override.'&'.$Wrng.'&'.$DoD.'&'.
1.15      minaeibi  994: 		       $SD.'&'.$Sk.'&'.$_D1.'&'.$_D2.'&'.
1.28      minaeibi  995:                        $DiscNo.'&'.$Prob;
1.5       minaeibi  996: 	    $CachData{($p_count-1)}=$join;
                    997: 
1.28      minaeibi  998: #6666666
                    999: #	    $r->print('<br>'.$out.'&'.$DoD);
                   1000: #            print (OUT $out.'@'.$DoD.'&');
                   1001: #6666666
                   1002: 
1.5       minaeibi 1003: 	    $urlres=~/^(\w+)\/(\w+)/;
                   1004: 	    if ($StdNo) { 
                   1005: 		&Apache::lonnet::put('resevaldata',\%storestats,$1,$2); 
                   1006: 	    }
1.1       albertel 1007: #-------------------------------- Row of statistical table
1.27      stredwic 1008:             &TableRow($cache,$join,$i,($p_count-1));
1.5       minaeibi 1009: 	}
1.27      stredwic 1010: 	&CloseTable($cache);
1.1       albertel 1011:     }
1.15      minaeibi 1012:     &Close_PrgWin();
1.28      minaeibi 1013: #666666
                   1014: #    close( OUT );
                   1015: #666666
1.1       albertel 1016: }
                   1017: 
1.27      stredwic 1018: =pod
1.1       albertel 1019: sub Cache_Statistics {
1.27      stredwic 1020:     my ($cache)=@_;
1.1       albertel 1021:     my @list = ();
                   1022:     my $Useful;
                   1023:     my $UnUseful;
1.20      minaeibi 1024: #    $r->print('<input type="hidden" name="show" value="excel" />'."\n"); 
1.1       albertel 1025:     my %myHeader = reverse( %Header );
                   1026:     $Pos = $myHeader{$ENV{'form.sort'}};
1.5       minaeibi 1027:     if ($Pos > 0) {$Pos++;}
1.27      stredwic 1028:     my $p_count = 0;
1.1       albertel 1029:     foreach my $key( keys %CachData) { 
1.12      minaeibi 1030: 	my @Temp=split(/\&/,$CachData{$key});
1.6       minaeibi 1031: 	if ( $Pos == 0 ) {
1.1       albertel 1032: 	    ($UnUseful,$Useful)=split(/\>/,$Temp[$Pos]);
                   1033: 	}
                   1034: 	else {
                   1035: 	    $Useful = $Temp[$Pos];
                   1036: 	}   
1.12      minaeibi 1037: 	$list[$p_count]=$Useful.'@'.$CachData{$key};
1.1       albertel 1038:         $p_count++;
                   1039:     }
                   1040: 
                   1041:     @list = sort MySort (@list);
                   1042: 
1.27      stredwic 1043:     my $nIndex=0;
1.5       minaeibi 1044: 
                   1045:     if ( $Pos == 0 ) {
                   1046: 	foreach (sort keys %mapsort) {
                   1047: 	    my ($Hid,$pr)=split(/\:/,$mapsort{$_});
1.27      stredwic 1048: 	    &CreateProblemStatisticsTableHeading($cache,1,$Hid);
1.5       minaeibi 1049: 	    my @lpr=split(/\&/,$pr);
                   1050: 	    for (my $i=1; $i<=$#lpr; $i++) {
1.27      stredwic 1051: 		my($Pre, $Post) = split(/\@/,$list[$nIndex]); 
1.12      minaeibi 1052: 		#$r->print('<br>'.$Pre.'---'.$Post);
1.27      stredwic 1053: 		&TableRow($cache,$Post,$i,$nIndex);
                   1054: 		$nIndex++;
1.5       minaeibi 1055: 	    }
1.27      stredwic 1056: 	    &CloseTable($cache);
1.5       minaeibi 1057: 	}
                   1058:     }
                   1059:     else {
1.27      stredwic 1060: 	&CreateProblemStatisticsTableHeading($cache,0);
                   1061: 	for ( my $nIndex = 0; $nIndex < $p_count; $nIndex++ ) {
                   1062: 	    my($Pre, $Post) = split(/\@/,$list[$nIndex]); 
                   1063: 	    &TableRow($cache,$Post,$nIndex,$nIndex);
1.5       minaeibi 1064: 	} 
1.27      stredwic 1065: 	&CloseTable($cache);
1.5       minaeibi 1066:     }
                   1067: }
1.28      minaeibi 1068: =cut 
                   1069: 
                   1070: 
                   1071: 
1.5       minaeibi 1072: sub TableRow {
1.28      minaeibi 1073:     my ($Str,$Idx,$RealIdx)=@_;
1.12      minaeibi 1074:     my($PrOrd,$Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override,
1.28      minaeibi 1075:        $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$DiscNo,$Prob)=split(/\&/,$Str);	
                   1076:     if ($ENV{'form.showcsv'}) {
1.18      minaeibi 1077:         my ($ResId,$Dummy)=split(/\*/,$Prob);
                   1078:         my $Ptr =  "\n".'<br>'.
                   1079:                "\n".'"'.($RealIdx+1).'",'.
                   1080:                "\n".'"'.$hash{'title_'.$ResId}.$Dummy.'",'.
                   1081:                "\n".'"'.$hash{'src_'.$ResId}.'",'.
                   1082:                "\n".'"'.$StdNo.'",'.
                   1083:                "\n".'"'.$TotalTries.'",'.
                   1084:                "\n".'"'.$MxTries.'",'.
                   1085:                "\n".'"'.$Avg.'",'.
                   1086:                "\n".'"'.$YES.'",'.
                   1087:                "\n".'"'.$Override.'",'.
                   1088:                "\n".'"'.$Wrng.'",'.
                   1089:                "\n".'"'.$DoD.'",'.
                   1090:                "\n".'"'.$SD.'",'.
                   1091:                "\n".'"'.$Sk.'",'.
                   1092:                "\n".'"'.$_D1.'",'.
1.28      minaeibi 1093: 	       "\n".'"'.$_D2.'"'.
                   1094: 	       "\n".'"'.$DiscNo.'"';
                   1095: 
1.18      minaeibi 1096:         $r->print("\n".$Ptr);
1.28      minaeibi 1097:     }
                   1098:     else{
1.18      minaeibi 1099:         my $Ptr =  "\n".'<tr>'.
1.5       minaeibi 1100:                "\n".'<td>'.($RealIdx+1).'</td>'.
1.13      minaeibi 1101:           #     "\n".'<td>'.$PrOrd.$Temp.'</td>'.
1.8       minaeibi 1102:                "\n".'<td>'.$Temp.'</td>'.
1.25      minaeibi 1103:                "\n".'<td bgcolor='.$color{"yellow"}.'> '.$StdNo.'</td>'.
                   1104:                "\n".'<td bgcolor='.$color{"yellow"}.'>'.$TotalTries.'</td>'.
                   1105:                "\n".'<td bgcolor='.$color{"yellow"}.'>'.$MxTries.'</td>'.
                   1106:                "\n".'<td bgcolor='.$color{"gb"}.'>'.$Avg.'</td>'.
                   1107:                "\n".'<td bgcolor='.$color{"gb"}.'> '.$YES.'</td>'.
                   1108:                "\n".'<td bgcolor='.$color{"gb"}.'> '.$Override.'</td>'.
                   1109:                "\n".'<td bgcolor='.$color{"red"}.'> '.$Wrng.'</td>'.
                   1110:                "\n".'<td bgcolor='.$color{"red"}.'> '.$DoD.'</td>'.
                   1111:                "\n".'<td bgcolor='.$color{"green"}.'> '.$SD.'</td>'.
                   1112:                "\n".'<td bgcolor='.$color{"green"}.'> '.$Sk.'</td>'.
                   1113:                "\n".'<td bgcolor='.$color{"purple"}.'> '.$_D1.'</td>'.
1.28      minaeibi 1114: 	       "\n".'<td bgcolor='.$color{"purple"}.'> '.$_D2.'</td>'.
                   1115:                "\n".'<td bgcolor='.$color{"yellow"}.'> '.$DiscNo.'</td>';
1.18      minaeibi 1116:         $r->print("\n".$Ptr.'</tr>' );
                   1117:     }
1.5       minaeibi 1118:     $GraphDat{$RealIdx}=$DoD.':'.$Wrng;
1.1       albertel 1119: }
1.29    ! stredwic 1120: 
1.27      stredwic 1121: sub StatusOptions {
                   1122:     my ($cache)=@_;
                   1123: 
                   1124:     my $Status = $cache->{'Status'};
                   1125:     my $OpSel1 = '';
                   1126:     my $OpSel2 = '';
                   1127:     my $OpSel3 = '';
                   1128: 
                   1129:     if($Status eq 'Any')         { $OpSel3 = ' selected'; }
                   1130:     elsif($Status eq 'Expired' ) { $OpSel2 = ' selected'; }
                   1131:     else                         { $OpSel1 = ' selected'; }
                   1132: 
                   1133:     my $Ptr = '';
                   1134:     $Ptr .= '<tr><td align="right"><b>Student Status:</b></td>'."\n";
                   1135:     $Ptr .= '<td align="left"><select name="Status">';
                   1136:     $Ptr .= '<option'.$OpSel1.'>Active</option>'."\n";
                   1137:     $Ptr .= '<option'.$OpSel2.'>Expired</option>'."\n";
                   1138:     $Ptr .= '<option'.$OpSel3.'>Any</option>'."\n";
                   1139:     $Ptr .= '</select></td></tr>'."\n";
                   1140: 
                   1141:     return $Ptr;
                   1142: }
                   1143: 
                   1144: sub AscendOrderOptions {
                   1145:     my ($cache)=@_;
                   1146: 
                   1147:     my $order = $cache->{'Ascend'};
                   1148:     my $OpSel1 = '';
                   1149:     my $OpSel2 = '';
                   1150: 
                   1151:     if($order eq 'Ascending') {
                   1152:         $OpSel1 = ' selected';
                   1153:     } else {
                   1154:         $OpSel2 = ' selected';
                   1155:     }
                   1156: 
                   1157:     my $Ptr = '';
                   1158:     $Ptr .= '<tr><td align="right"><b>Sorting Type:</b></td>'."\n";
                   1159:     $Ptr .= '<td align="left"><select name="Ascend">'."\n";
                   1160:     $Ptr .= '<option'.$OpSel1.'>Ascending</option>'."\n".
                   1161: 	    '<option'.$OpSel2.'>Descending</option>'."\n";
                   1162:     $Ptr .= '</select></td></tr>'."\n";
                   1163: 
                   1164:     return $Ptr;
                   1165: }
                   1166: 
                   1167: sub ProblemStatisticsButtons {
                   1168:     my ($cache)=@_;
                   1169: 
                   1170:     my $Ptr = '<tr><td></td><td align="left">';
                   1171:     $Ptr .= '<input type=submit name="ProblemStatisticsRecalculate" ';
                   1172:     $Ptr .= 'value="Recalculate Statistics"/>'."\n";
                   1173:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                   1174:     $Ptr .= '<input type="submit" name="DoDiffGraph" ';
                   1175:     $Ptr .= 'value="DoDiff Graph" />'."\n";
                   1176:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                   1177:     $Ptr .= '<input type="submit" name="PercentWrongGraph" ';
                   1178:     $Ptr .= 'value="%Wrong Graph" />'."\n";
                   1179:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                   1180:     $Ptr .= '<input type="submit" name="DisplayCSVFormat" ';
                   1181:     if($cache->{'DisplayFormat'} eq 'Display CSV Format') {
                   1182:         $Ptr .= 'value="Display CSV Format" />'."\n";
                   1183:     } else {
                   1184:         $Ptr .= 'value="Display Table Format" />'."\n";
                   1185:     }
                   1186:     $Ptr .= '</td></tr>';
                   1187: 
                   1188:     return $Ptr;
                   1189: }
                   1190: 
                   1191: sub ProblemStatisticsLegend {
                   1192:     my $Ptr = '';
                   1193:     $Ptr = '<table border="0">';
                   1194:     $Ptr .= '<tr><td>';
                   1195:     $Ptr .= '<b>#Stdnts</b>:</td>';
                   1196:     $Ptr .= '<td>Total Number of Students opened the problem.';
                   1197:     $Ptr .= '</td></tr><tr><td>';
                   1198:     $Ptr .= '<b>Tries</b>:</td>';
                   1199:     $Ptr .= '<td>Total Number of Tries for solving the problem.';
                   1200:     $Ptr .= '</td></tr><tr><td>';
                   1201:     $Ptr .= '<b>Mod</b>:</td>';
                   1202:     $Ptr .= '<td>Maximunm Number of Tries for solving the problem.';
                   1203:     $Ptr .= '</td></tr><tr><td>';
                   1204:     $Ptr .= '<b>Mean</b>:</td>';
                   1205:     $Ptr .= '<td>Average Number of the tries. [ Tries / #Stdnts ]';
                   1206:     $Ptr .= '</td></tr><tr><td>';
                   1207:     $Ptr .= '<b>#YES</b>:</td>';
                   1208:     $Ptr .= '<td>Number of students solved the problem correctly.';
                   1209:     $Ptr .= '</td></tr><tr><td>';
                   1210:     $Ptr .= '<b>#yes</b>:</td>';
                   1211:     $Ptr .= '<td>Number of students solved the problem by override.';
                   1212:     $Ptr .= '</td></tr><tr><td>';
                   1213:     $Ptr .= '<b>%Wrng</b>:</td>';
                   1214:     $Ptr .= '<td>Percentage of students tried to solve the problem ';
                   1215:     $Ptr .= 'but still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]';
                   1216:     $Ptr .= '</td></tr><tr><td>';
                   1217: #    Kashy formula
                   1218: #    '<b>  DoDiff </b>: Degree of Difficulty of the problem.<br>'.
                   1219: #    '[ Tries/(#YES+#yes+0.1) ]<br>'.
                   1220:     #Gerd formula
                   1221:     $Ptr .= '<b>DoDiff</b>:</td>';
                   1222:     $Ptr .= '<td>Degree of Difficulty of the problem.  ';
                   1223:     $Ptr .= '[ 1 - ((#YES+#yes) / Tries) ]';
                   1224:     $Ptr .= '</td></tr><tr><td>';
                   1225:     $Ptr .= '<b>S.D.</b>:</td>';
                   1226:     $Ptr .= '<td>Standard Deviation of the tries.  ';
                   1227:     $Ptr .= '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) ';
                   1228:     $Ptr .= 'where Xi denotes every student\'s tries ]';
                   1229:     $Ptr .= '</td></tr><tr><td>';
                   1230:     $Ptr .= '<b>Skew.</b>:</td>';
                   1231:     $Ptr .= '<td>Skewness of the students tries.';
                   1232:     $Ptr .= '[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]';
                   1233:     $Ptr .= '</td></tr><tr><td>';
                   1234:     $Ptr .= '<b>Dis.F.</b>:</td>';
                   1235:     $Ptr .= '<td>Discrimination Factor: A Standard for evaluating the ';
                   1236:     $Ptr .= 'problem according to a Criterion<br>';
                   1237:     $Ptr .= '<b>[Applied Criterion in %27 Upper Students - ';
                   1238:     $Ptr .= 'Applied the same Criterion in %27 Lower Students]</b><br>';
                   1239:     $Ptr .= '<b>1st Criterion</b> for Sorting the Students: ';
                   1240:     $Ptr .= '<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>';
                   1241:     $Ptr .= '<b>2nd Criterion</b> for Sorting the Students: ';
                   1242:     $Ptr .= '<b>Total number of Correct Answers / Total Number of Tries</b>';
1.29    ! stredwic 1243:     $Ptr .= '</td></tr>';
        !          1244:     $Ptr .= '<tr><td><b>Disc.</b></td>';
1.28      minaeibi 1245:     $Ptr .= '<td>Number of Students had at least one discussion.';
1.27      stredwic 1246:     $Ptr .= '</td></tr></table>';
                   1247: 
                   1248:     return $Ptr;
                   1249: }
                   1250: 
                   1251: #---- END Problem Statistics Web Page ----------------------------------------
                   1252: 
                   1253: #---- Problem Statistics Graph Web Page --------------------------------------
1.1       albertel 1254: 
1.28      minaeibi 1255: # ------------------------------------------- Prepare data for Graphical chart
                   1256: 
1.1       albertel 1257: sub GetGraphData {
1.28      minaeibi 1258:     my $ylab = shift;
                   1259:     my $Col;
1.1       albertel 1260:     my $data='';
                   1261:     my $count = 0;
                   1262:     my $Max = 0;
1.28      minaeibi 1263:     my $cid=$ENV{'request.course.id'};
1.1       albertel 1264:     my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
1.28      minaeibi 1265:                   "_$ENV{'user.domain'}_$cid\_graph.db";
                   1266:     foreach (keys %GraphDat) {delete $GraphDat{$_};}
                   1267:     if (-e "$GraphDB") {
                   1268: 	if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) {
                   1269: 	    if ( $ylab eq 'DoDiff Graph' ) {
                   1270: 		$ylab = 'Degree-of-Difficulty';
1.1       albertel 1271: 		$Col = 0;
1.28      minaeibi 1272: 	    }
                   1273: 	    else {
                   1274: 		$ylab = 'Wrong-Percentage';
1.1       albertel 1275: 		$Col = 1;
                   1276: 	    }
                   1277: 	    foreach (sort NumericSort keys %GraphDat) { 
                   1278: 		my @Temp=split(/\:/,$GraphDat{$_});
                   1279:                 my $inf = $Temp[$Col]; 
1.28      minaeibi 1280: 		if ( $Max < $inf ) {$Max = $inf;}
1.1       albertel 1281: 		$data .= $inf.',';
                   1282: 		$count++;
                   1283: 	    }
1.28      minaeibi 1284: 	    if ( $Max > 1 ) { 
1.15      minaeibi 1285: 		$Max += (10 - $Max % 10);
                   1286: 		$Max = int($Max);
1.28      minaeibi 1287: 	    }
                   1288: 	    else { $Max = 1; }
1.1       albertel 1289:             untie(%GraphDat);
1.28      minaeibi 1290: 	    my $Course = $ENV{'course.'.$cid.'.description'};
1.1       albertel 1291: 	    $Course =~ s/\ /"_"/eg;
1.28      minaeibi 1292: 	    $GData=$Course.'&'.'Problems'.'&'.$ylab.'&'.$Max.'&'.$count.'&'.$data;
                   1293: 	}
                   1294: 	else {
                   1295: 	    $r->print("Unable to tie hash to db file");
1.27      stredwic 1296: 	}
                   1297:     }
                   1298: }
                   1299: #---- Problem Analysis Web Page ----------------------------------------------
                   1300: 
                   1301: sub IntervalOptions {
                   1302:     my ($cache)=@_;
                   1303: 
                   1304:     my $interval = 1;
                   1305:     for(my $n=1; $n<=7; $n++) {
                   1306:         if($cache->{'Interval'} == $n) {
                   1307:             $interval = $n;
                   1308:         }
                   1309:     }
                   1310: 
                   1311:     my $Ptr = '<br><b>Select number of intervals</b>'."\n".
                   1312:        	      '<select name="Interval">'."\n";
                   1313:     for(my $n=1; $n<=7;$ n++) {
                   1314: 	$Ptr .= '<option';
                   1315:         if($interval == $n) {
                   1316:             $Ptr .= ' selected';
                   1317:         }
                   1318: 	$Ptr .= '>'.$n."</option>"."\n";
                   1319:     }
                   1320:     $Ptr .= '</select>'."\n";
                   1321: 
                   1322:     return $Ptr;
                   1323: }
                   1324: 
                   1325: sub OptionResponseTable {
                   1326:     my ($cache)=@_;
                   1327:     my $Str = '';
                   1328:     $Str .= '<br><b> Option Response Problems in this course:</b>'."\n";
                   1329:     $Str .= '<br><br>'."\n";
                   1330:     $Str .= "<table border=2><tr><th> \# </th><th> Problem Title </th>";
                   1331:     $Str .= '<th> Resource </th><th> Analysis  </th></tr>'."\n";
                   1332: 
                   1333:     my $number=1;
                   1334:     foreach (split(':::',$cache->{'OptionResponses'})) {
                   1335:         my ($uri,$title,$part,$problem)=split('::',$_);
                   1336:         my $Temp = '<a href="'.$uri.'" target="_blank">'.$title.'</a>';
                   1337:         $Str .= '<tr>';
                   1338:         $Str .= '<td> '.$number.' </td>';
                   1339:         $Str .= '<td bgcolor="'.$color{"green"}.'"> '.$Temp.' </td>';
                   1340:         $Str .= '<td bgcolor="'.$color{"yellow"}.'"> '.$uri.' </td>';
                   1341:         $Str .= '<td><input type="submit" name="Analyze:::'.$uri.':::';
                   1342:         $Str .= $title.':::'.$part.':::'.$problem.'" value="';
                   1343:         $Str .= 'Analyze" /></td></tr>'."\n";
                   1344:         $number++;
                   1345:     }
                   1346:     $Str .= '</table>'."\n";
                   1347: 
                   1348:     return $Str;
                   1349: }
                   1350: 
                   1351: #---- END Problem Analysis Web Page ------------------------------------------
                   1352: 
                   1353: #---- Student Assessment Web Page --------------------------------------------
                   1354: 
                   1355: # ------ Create different Student Report 
                   1356: sub StudentReport {
                   1357:     my ($cache, $name)=@_;
                   1358: 
                   1359:     my $Str = '';
                   1360:     if($cache->{$name.':error'} =~ /course/) {
                   1361:         my ($username)=split(':',$name);
                   1362:         $Str .= '<b><font color="blue">No course data for student </font>';
                   1363:         $Str .= '<font color="red">'.$username.'.</font></b><br>';
                   1364:         return $Str;
                   1365:     }
                   1366: 
                   1367:     $Str .= "<table border=2><tr><th> \# </th><th> Set Title </th>";
                   1368:     $Str .= '<th> Results </th><th> Tries </th></tr>'."\n";
                   1369: 
                   1370:     my $codes;
                   1371:     my $attempts;
                   1372:     foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
                   1373:         if($cache->{'StudentAssessmentMap'} ne 'All Maps'  &&
                   1374:            $cache->{'StudentAssessmentMap'} ne $cache->{$sequence.':title'}) {
                   1375:             next;
                   1376:         }
                   1377: 
                   1378:         $Str .= '<tr><td>'.$sequence.'</td>';
                   1379:         $Str .= '<td>'.$cache->{$sequence.':title'}.'</td>';
                   1380: 
                   1381:         $codes = '';
                   1382:         $attempts = '';
                   1383:         foreach my $problemID (split(':', $cache->{$sequence.':problems'})) {
                   1384:             my $problem = $cache->{$problemID.':problem'};
                   1385:             my $LatestVersion = $cache->{$name.':version:'.$problem};
                   1386: 
                   1387:             # Output dashes for all the parts of this problem if there
                   1388:             # is no version information about the current problem.
                   1389:             if(!$LatestVersion) {
                   1390:                 foreach my $part (split(/\:/,$cache->{$sequence.':'.
                   1391:                                                       $problemID.
                   1392:                                                       ':parts'})) {
                   1393: 		    $codes    .= "-,";
                   1394:                     $attempts .= "0,"; 
                   1395:                 }
                   1396:                 next;
                   1397:             }
                   1398: 
                   1399:             my %partData=undef;
                   1400:             # Initialize part data, display skips correctly
                   1401:             # Skip refers to when a student made no submissions on that
                   1402:             # part/problem.
                   1403:             foreach my $part (split(/\:/,$cache->{$sequence.':'.
                   1404:                                                   $problemID.
                   1405:                                                   ':parts'})) {
                   1406:                 $partData{$part.':tries'}=0;
                   1407:                 $partData{$part.':code'}='-';
                   1408:             }
                   1409: 
                   1410:             # Looping through all the versions of each part, starting with the
                   1411:             # oldest version.  Basically, it gets the most recent 
                   1412:             # set of grade data for each part.
                   1413: 	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
                   1414:                 foreach my $part (split(/\:/,$cache->{$sequence.':'.
                   1415:                                                       $problemID.
                   1416:                                                       ':parts'})) {
                   1417: 
                   1418:                     if(!defined($cache->{$name.":$Version:$problem".
                   1419:                                                ":resource.$part.solved"})) {
                   1420:                         # No grade for this submission, so skip
                   1421:                         next;
                   1422:                     }
                   1423: 
                   1424:                     my $tries=0;
                   1425:                     my $code='U';
                   1426: 
                   1427:                     $tries = $cache->{$name.":$Version:$problem".
                   1428:                                       ":resource.$part.tries"};
                   1429:                     $partData{$part.':tries'}=($tries) ? $tries : 0;
                   1430: 
                   1431:                     my $val = $cache->{$name.":$Version:$problem".
                   1432:                                        ":resource.$part.solved"};
                   1433:                     if    ($val eq 'correct_by_student')   {$code = 'Y';} 
                   1434:                     elsif ($val eq 'correct_by_override')  {$code = 'y';}
                   1435:                     elsif ($val eq 'incorrect_attempted')  {$code = 'N';} 
                   1436:                     elsif ($val eq 'incorrect_by_override'){$code = 'N';}
                   1437:                     elsif ($val eq 'excused')              {$code = 'x';}
                   1438:                     $partData{$part.':code'}=$code;
                   1439:                 }
                   1440:             }
                   1441: 
                   1442:             # Loop through all the parts for the current problem in the 
                   1443:             # correct order and prepare the output
                   1444:             foreach (split(/\:/,$cache->{$sequence.':'.$problemID.
                   1445:                                          ':parts'})) {
                   1446:                 $codes    .= $partData{$_.':code'}.',';
                   1447:                 $attempts .= $partData{$_.':tries'}.','; 
                   1448:             }
                   1449:         }
                   1450:         $codes    =~ s/,$//;
                   1451:         $attempts =~ s/,$//;
                   1452:         $Str .= '<td>'.$codes.'</td>';
                   1453:         $Str .= '<td>'.$attempts.'</td>';
                   1454:         $Str .= '</tr>'."\n";
                   1455:     }
                   1456: 
                   1457:     $Str .= '</table>'."\n";
                   1458: 
                   1459:     return $Str;
                   1460: }
                   1461: 
                   1462: #---- END Student Assessment Web Page ----------------------------------------
                   1463: 
                   1464: #---- Menu Web Page ----------------------------------------------------------
                   1465: 
                   1466: #---- END Menu Web Page ------------------------------------------------------
                   1467: 
                   1468: #---- HELPER FUNCTIONS -------------------------------------------------------
                   1469: 
                   1470: sub CheckFormElement {
                   1471:     my ($cache, $ENVName, $cacheName, $default)=@_;
                   1472: 
                   1473:     if(defined($ENV{'form.'.$ENVName})) {
                   1474:         $cache->{$cacheName} = $ENV{'form.'.$ENVName};
                   1475:     } elsif(!defined($cache->{$cacheName})) {
                   1476:         $cache->{$cacheName} = $default;
                   1477:     }
                   1478: 
                   1479:     return;
                   1480: }
                   1481: 
                   1482: sub ProcessFormData{
1.29    ! stredwic 1483:     my ($cache)=@_;
1.27      stredwic 1484: 
1.29    ! stredwic 1485:     $cache->{'reportKey'} = 'false';
1.27      stredwic 1486: 
1.29    ! stredwic 1487:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
        !          1488:                                             ['sort','download']);
        !          1489:     &CheckFormElement($cache, 'Status', 'Status', 'Active');
        !          1490:     &CheckFormElement($cache, 'postdata', 'reportSelected', 'Class list');
        !          1491:     &CheckFormElement($cache, 'reportSelected', 'reportSelected', 
        !          1492:                       'Class list');
        !          1493:     &CheckFormElement($cache, 'DownloadAll', 'DownloadAll', 'false');
        !          1494:     &CheckFormElement($cache, 'sort', 'sort', 'fullname');
        !          1495:     &CheckFormElement($cache, 'download', 'download', 'false');
        !          1496: 
        !          1497:     if(defined($ENV{'form.CreateStudentAssessment'}) ||
        !          1498:        defined($ENV{'form.NextStudent'}) ||
        !          1499:        defined($ENV{'form.PreviousStudent'})) {
        !          1500:         $cache->{'reportSelected'} = 'Student Assessment';
        !          1501:     }
        !          1502:     if(defined($ENV{'form.NextStudent'})) {
        !          1503:         $cache->{'StudentAssessmentMove'} = 'next';
        !          1504:     } elsif(defined($ENV{'form.PreviousStudent'})) {
        !          1505:         $cache->{'StudentAssessmentMove'} = 'previous';
        !          1506:     } else {
        !          1507:         $cache->{'StudentAssessmentMove'} = 'selected';
        !          1508:     }
        !          1509:     &CheckFormElement($cache, 'StudentAssessmentMap', 'StudentAssessmentMap', 
        !          1510:                       'All Maps');
        !          1511:     &CheckFormElement($cache, 'StudentAssessmentStudent', 
        !          1512:                       'StudentAssessmentStudent', 'No Student Selected');
        !          1513: 
        !          1514:     foreach (keys(%ENV)) {
        !          1515:         if(/form\.Analyze:::/) {
        !          1516: #            $cache->{'reportSelected'} = 'Analyze';
        !          1517: #            $cache->{'reportKey'} = 'Problem Analysis';
        !          1518:             my ($uri, $title, $part, $problem);
        !          1519:             (undef, $uri, $title, $part, $problem)=split(':::', $_);
        !          1520:             $cache->{'AnalyzeURI'}     = $uri;
        !          1521:             $cache->{'AnalyzeTitle'}   = $title;
        !          1522:             $cache->{'AnalyzePart'}    = $part;
        !          1523:             $cache->{'AnalyzeProblem'} = $problem;
        !          1524:             
        !          1525:             &CheckFormElement($cache, 'Interval', 'Interval', '1');
1.27      stredwic 1526:         }
1.29    ! stredwic 1527:     }
1.27      stredwic 1528: 
1.29    ! stredwic 1529:     return;
1.27      stredwic 1530: 
1.29    ! stredwic 1531:     # Select page to display
        !          1532:     if(defined($ENV{'form.ProblemStatistics'}) ||
        !          1533:        defined($ENV{'form.ProblemStatisticsRecalculate'}) || 
        !          1534:        defined($ENV{'form.DisplayCSVFormat'})) {
        !          1535:         $cache->{'GoToPage'} = 'ProblemStatistics';
        !          1536:         &CheckFormElement($cache, 'DisplayCSVFormat',
        !          1537:                           'DisplayFormat', 'Display Table Format');
        !          1538:         &CheckFormElement($cache, 'Ascend','ProblemStatisticsAscend',
        !          1539:                           'Ascending');
        !          1540:         &CheckFormElement($cache, 'Maps', 'ProblemStatisticsMap', 
        !          1541:                           'All Maps');
        !          1542:     } elsif(defined($ENV{'form.ProblemAnalysis'})) {
        !          1543:         $cache->{'GoToPage'} = 'ProblemAnalysis';
        !          1544:         &CheckFormElement($cache, 'Interval', 'Interval', '1');
        !          1545:     } elsif(defined($ENV{'form.DoDiffGraph'})) {
        !          1546:         $cache->{'GoToPage'} = 'DoDiffGraph';
        !          1547:     } elsif(defined($ENV{'form.PercentWrongGraph'})) {
        !          1548:         $cache->{'GoToPage'} = 'PercentWrongGraph';
        !          1549:     } elsif(defined($ENV{'form.ActivityLog'})) {
        !          1550:         $cache->{'GoToPage'} = 'ActivityLog';
        !          1551:     } else {
        !          1552:         $cache->{'GoToPage'} = 'Menu';
        !          1553:     }
1.27      stredwic 1554: 
1.29    ! stredwic 1555:     &CheckFormElement($cache, 'Status', 'Status', 'Active');
1.27      stredwic 1556: 
                   1557:     return;
                   1558: }
                   1559: 
                   1560: =pod
                   1561: 
                   1562: =item &SortStudents()
                   1563: 
                   1564: Determines which students to display and in which order.  Which are 
                   1565: displayed are determined by their status(active/expired).  The order
                   1566: is determined by the sort button pressed (default to username).  The
                   1567: type of sorting is username, lastname, or section.
                   1568: 
                   1569: =over 4
                   1570: 
                   1571: Input: $students, $CacheData
                   1572: 
                   1573: $students: A array pointer to a list of students (username:domain)
                   1574: 
                   1575: $CacheData: A pointer to the hash tied to the cached data
                   1576: 
                   1577: Output: \@order
                   1578: 
                   1579: @order: An ordered list of students (username:domain)
                   1580: 
                   1581: =back
                   1582: 
                   1583: =cut
                   1584: 
                   1585: sub SortStudents {
1.29    ! stredwic 1586:     my ($cache)=@_;
1.27      stredwic 1587: 
1.29    ! stredwic 1588:     my @students = split(':::',$cache->{'NamesOfStudents'});
1.27      stredwic 1589:     my @sorted1Students=();
1.29    ! stredwic 1590:     foreach (@students) {
        !          1591:         if($cache->{'Status'} eq 'Any' || 
        !          1592:            $cache->{$_.':Status'} eq $cache->{'Status'}) {
        !          1593:             push(@sorted1Students, $_);
        !          1594:         }
1.1       albertel 1595:     }
1.27      stredwic 1596: 
1.29    ! stredwic 1597:     my $sortBy = '';
        !          1598:     if(defined($cache->{'sort'})) {
        !          1599:         $sortBy = ':'.$cache->{'sort'};
1.27      stredwic 1600:     }
1.29    ! stredwic 1601:     my @order = sort { $cache->{$a.$sortBy} cmp $cache->{$b.$sortBy} ||
        !          1602:                        $cache->{$a.':fullname'} cmp $cache->{$b.':fullname'} } 
        !          1603:                 @sorted1Students;
1.27      stredwic 1604: 
                   1605:     return \@order;
                   1606: }
                   1607: 
                   1608: sub PrepareData {
                   1609:     my ($c, $cacheDB)=@_;
                   1610: 
                   1611:     # Test for access to the cache data
                   1612:     my $courseID=$ENV{'request.course.id'};
                   1613:     my $isRecalculate=0;
1.29    ! stredwic 1614:     if(defined($ENV{'form.Recalculate'})) {
1.27      stredwic 1615:         $isRecalculate=1;
                   1616:     }
                   1617: 
1.29    ! stredwic 1618:     my $isCached = &Apache::loncoursedata::TestCacheData($cacheDB, 
        !          1619:                                                          $isRecalculate);
1.27      stredwic 1620:     if($isCached < 0) {
                   1621:         return "Unable to tie hash to db file.";
                   1622:     }
                   1623: 
                   1624:     # Download class list information if not using cached data
                   1625:     my %cache;
1.29    ! stredwic 1626:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT,0640)) {
        !          1627:         return "Unable to tie hash to db file.";
        !          1628:     }
        !          1629: 
1.27      stredwic 1630:     if(!$isCached) {
                   1631:         my $processTopResourceMapReturn=
                   1632:             &Apache::loncoursedata::ProcessTopResourceMap(\%cache, $c);
                   1633:         if($processTopResourceMapReturn ne 'OK') {
                   1634:             untie(%cache);
                   1635:             return $processTopResourceMapReturn;
                   1636:         }
1.29    ! stredwic 1637:     }
1.27      stredwic 1638: 
1.29    ! stredwic 1639:     if($c->aborted()) {
        !          1640:         untie(%cache);
        !          1641:         return 'aborted'; 
        !          1642:     }
1.27      stredwic 1643: 
1.29    ! stredwic 1644:     my $classlist=&Apache::loncoursedata::DownloadClasslist($courseID,
        !          1645:                                                 $cache{'ClasslistTimestamp'},
        !          1646:                                                 $c);
        !          1647:     foreach (keys(%$classlist)) {
        !          1648:         if(/^(con_lost|error|no_such_host)/i) {
1.27      stredwic 1649:             untie(%cache);
                   1650:             return "Error getting student data.";
                   1651:         }
1.29    ! stredwic 1652:     }
1.27      stredwic 1653: 
1.29    ! stredwic 1654:     if($c->aborted()) {
        !          1655:         untie(%cache);
        !          1656:         return 'aborted'; 
        !          1657:     }
        !          1658: 
        !          1659:     # Active is a temporary solution, remember to change
        !          1660:     Apache::loncoursedata::ProcessClasslist(\%cache,$classlist,$courseID,$c);
        !          1661:     if($c->aborted()) {
        !          1662:         untie(%cache);
        !          1663:         return 'aborted'; 
        !          1664:     }
1.27      stredwic 1665: 
1.29    ! stredwic 1666:     &ProcessFormData(\%cache);
        !          1667:     my $students = &SortStudents(\%cache);
1.27      stredwic 1668: 
1.29    ! stredwic 1669:     if($cache{'download'} ne 'false') {
        !          1670:         my $who = $cache{'download'};
        !          1671:         my $courseData = 
        !          1672:             &Apache::loncoursedata::DownloadStudentCourseInformation(
        !          1673:                                              $who, $courseID, 
        !          1674:                                              $cache{$who.':lastDownloadTime'});
        !          1675:         &Apache::loncoursedata::ProcessStudentData(\%cache, $courseData, $who);
        !          1676:         $cache{'download'} = 'false';
        !          1677:     } elsif($cache{'DownloadAll'} ne 'false') {
        !          1678:         my @allStudents;
        !          1679:         if($cache{'DownloadAll'} eq 'sorted') {
        !          1680:             @allStudents = @$students;
        !          1681:         } else {
        !          1682:             @allStudents = split(':::', $cache{'NamesOfStudents'});
        !          1683:         }
        !          1684:         foreach (@allStudents) {
        !          1685:             my $courseData = 
        !          1686:                 &Apache::loncoursedata::DownloadStudentCourseInformation(
        !          1687:                                              $_, $courseID, 
        !          1688:                                              $cache{$_.':lastDownloadTime'});
        !          1689:             &Apache::loncoursedata::ProcessStudentData(\%cache, $courseData, 
        !          1690:                                                        $_);
        !          1691:             if($c->aborted()) {
        !          1692:                 untie(%cache);
        !          1693:                 return 'aborted'; 
        !          1694:             }
1.27      stredwic 1695:         }
1.29    ! stredwic 1696:         $cache{'DownloadAll'} = 'false';
        !          1697:     }
1.27      stredwic 1698: 
1.29    ! stredwic 1699:     if($c->aborted()) {
1.27      stredwic 1700:         untie(%cache);
1.29    ! stredwic 1701:         return 'aborted'; 
        !          1702:     }
        !          1703: 
        !          1704:     if($c->aborted()) {
        !          1705:         untie(%cache);
        !          1706:         return 'aborted'; 
1.27      stredwic 1707:     }
                   1708: 
1.29    ! stredwic 1709:     untie(%cache);
        !          1710: 
        !          1711:     return ('OK', $students);
1.27      stredwic 1712: }
                   1713: 
                   1714: # Create progress
                   1715: sub Create_PrgWin {
                   1716:     $r->print(<<ENDPOP);
                   1717:     <script>
                   1718:     popwin=open('','popwin','width=400,height=100');
                   1719:     popwin.document.writeln('<html><body bgcolor="#88DDFF">'+
                   1720:       '<title>LON-CAPA Statistics</title>'+
                   1721:       '<h4>Computation Progress</h4>'+
                   1722:       '<form name=popremain>'+
                   1723:       '<input type=text size=35 name=remaining value=Starting></form>'+
                   1724:       '</body></html>');
                   1725:     popwin.document.close();
                   1726:     </script>
                   1727: ENDPOP
                   1728: 
                   1729:     $r->rflush();
1.1       albertel 1730: }
                   1731: 
1.27      stredwic 1732: # update progress
                   1733: sub Update_PrgWin {
                   1734:     my ($totalStudents,$index,$name)=@_;
                   1735:     $r->print('<script>popwin.document.popremain.remaining.value="'.
                   1736:               'Computing '.$index.'/'.$totalStudents.': '.
                   1737:               $name.'";</script>');
                   1738:     $r->rflush();
                   1739: }
1.1       albertel 1740: 
1.27      stredwic 1741: # close Progress Line
                   1742: sub Close_PrgWin {
                   1743:     $r->print('<script>popwin.close()</script>');
                   1744:     $r->rflush(); 
1.25      minaeibi 1745: }
                   1746: 
                   1747: # For loading the colored table for display or un-colored for print
                   1748: sub setbgcolor {
                   1749:     my $PrintTable=shift;
                   1750:     undef %color;
                   1751:     if ($PrintTable){
                   1752: 	$color{"gb"}="#FFFFFF";
                   1753: 	$color{"red"}="#FFFFFF";
                   1754: 	$color{"yellow"}="#FFFFFF";
                   1755: 	$color{"green"}="#FFFFFF";
                   1756: 	$color{"purple"}="#FFFFFF";
                   1757:     } else {
                   1758: 	$color{"gb"}="#DDFFFF";
                   1759: 	$color{"red"}="#FFDDDD";
                   1760: 	$color{"yellow"}="#EEFFCC";
                   1761: 	$color{"green"}="#DDFFDD";
                   1762: 	$color{"purple"}="#FFDDFF";
                   1763:     }
1.27      stredwic 1764: 
                   1765:     return;
1.1       albertel 1766: }
                   1767: 
1.27      stredwic 1768: sub initial {
                   1769:     undef %hash;
                   1770:     undef %CachData;
                   1771:     undef %GraphDat;
                   1772:     undef %ConceptData;
                   1773:     undef $GData;
                   1774: }
1.19      minaeibi 1775: 
1.27      stredwic 1776: #---- END HELPER FUNCTIONS ---------------------------------------------------
1.1       albertel 1777: 
1.27      stredwic 1778: sub BuildProblemStatisticsPage {
1.29    ! stredwic 1779:     my ($cacheDB, $students, $courseID, $c)=@_;
1.1       albertel 1780: 
1.27      stredwic 1781:     my %cache;
                   1782:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
                   1783:         $r->print('<html><body>Unable to tie database.</body></html>');
                   1784:         return;
                   1785:     }
                   1786: 
                   1787:     my $Ptr = '';
                   1788:     $Ptr .= '<table border="0"><tbody>';
1.29    ! stredwic 1789:     $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
        !          1790:     $Ptr .= '<td align="left">';
        !          1791:     $Ptr .= &Apache::lonhtmlcommon::MapOptions(\%cache, 'ProblemStatistics');
        !          1792:     $Ptr .= '</td></tr>'."\n";
1.27      stredwic 1793:     $r->print($Ptr);
                   1794:     $r->print(&AscendOrderOptions());
                   1795:     $r->print(&ProblemStatisticsButtons(\%cache));
                   1796:     $r->print('</table>');
                   1797: 
                   1798:     $r->print(&ProblemStatisticsLegend());
                   1799: 
1.29    ! stredwic 1800:     untie(%cache);
        !          1801:     foreach (@$students) {
        !          1802:         my $courseData = 
        !          1803:             &Apache::loncoursedata::DownloadStudentCourseInformation($_, 
        !          1804:                                                                     $courseID);
        !          1805:         last if ($c->aborted());
        !          1806:         if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT,0640)) {
        !          1807:             &Apache::loncoursedata::ProcessStudentData(\%cache, 
        !          1808:                                                        $courseData, $_);
        !          1809:             untie(%cache);
        !          1810:         }
        !          1811:     }
        !          1812:     if($c->aborted()) { return; }
1.15      minaeibi 1813: 
1.29    ! stredwic 1814:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
        !          1815:         $r->print('<html><body>Unable to tie database.</body></html>');
        !          1816:         return;
        !          1817:     }
        !          1818:     my $discriminantFactor;
        !          1819:     my @list=();
        !          1820:     foreach (@$students) {
        !          1821:         $discriminantFactor = &ExtractStudentData(\%cache, $_, \@list);
        !          1822:     }
1.27      stredwic 1823: 
1.29    ! stredwic 1824:     my ($upper, $lower) = &Discriminant($discriminantFactor);
        !          1825:     my %Header = (0,"Homework Sets Order",1,"#Stdnts",2,"Tries",3,"Mod",
        !          1826:                   4,"Mean",5,"#YES",6,"#yes",7,"%Wrng",8,"DoDiff",
        !          1827:                   9,"S.D.",10,"Skew.",11,"D.F.1st",12,"D.F.2nd", 13, "Disc.");
        !          1828:     &BuildStatisticsTable(\%cache, $discriminantFactor, \@list, \%Header, 
        !          1829:                            $students);
1.27      stredwic 1830: 
                   1831:     untie(%cache);
                   1832: 
                   1833:     return;
                   1834: }
                   1835: 
                   1836: sub BuildDiffGraph {
                   1837:     my ($courseID)=@_;
                   1838: 
                   1839:     my $graphData = &GetGraphData('DiffGraph', $courseID);
                   1840:     $r->print('<IMG src="/cgi-bin/graph.gif?'.$graphData.'" />');
1.1       albertel 1841: 
1.27      stredwic 1842:     return;
1.15      minaeibi 1843: }
                   1844: 
1.27      stredwic 1845: sub BuildWrongGraph {
                   1846:     my ($courseID)=@_;
1.15      minaeibi 1847: 
1.27      stredwic 1848:     my $graphData = &GetGraphData('WrongGraph', $courseID);
                   1849:     $r->print('<IMG src="/cgi-bin/graph.gif?'.$graphData.'" />');
                   1850: 
                   1851:     return;
1.15      minaeibi 1852: }
                   1853: 
1.27      stredwic 1854: sub BuildAnalyzePage {
                   1855:     my ($cacheDB, $students, $courseID)=@_;
1.19      minaeibi 1856: 
1.27      stredwic 1857:     my %cache;
                   1858:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
                   1859:         $r->print('<html><body>Unable to tie database.</body></html>');
                   1860:         return;
1.15      minaeibi 1861:     }
1.1       albertel 1862: 
1.27      stredwic 1863:     &ShowOpGraph(\%cache, $students, $courseID);
1.1       albertel 1864: 
1.27      stredwic 1865:     untie(%cache);
1.26      minaeibi 1866: 
1.27      stredwic 1867:     return;
1.1       albertel 1868: }
1.21      minaeibi 1869: 
1.27      stredwic 1870: sub BuildProblemAnalysisPage {
                   1871:     my ($cacheDB)=@_;
1.1       albertel 1872: 
1.27      stredwic 1873:     my %cache;
                   1874:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
                   1875:         $r->print('<html><body>Unable to tie database.</body></html>');
                   1876:         return;
1.1       albertel 1877:     }
1.27      stredwic 1878: 
                   1879:     $r->print(&IntervalOptions());
                   1880:     $r->print(&OptionResponseTable(\%cache));
                   1881: 
                   1882:     untie(%cache);
                   1883: 
                   1884:     return;
1.1       albertel 1885: }
                   1886: 
1.27      stredwic 1887: sub BuildStudentAssessmentPage {
1.29    ! stredwic 1888:     my ($cacheDB, $students, $courseID, $c)=@_;
1.15      minaeibi 1889: 
1.27      stredwic 1890:     my %cache;
1.1       albertel 1891: 
1.27      stredwic 1892:     my $Ptr = '';
                   1893:     $Ptr .= '<table border="0"><tbody>';
                   1894:     $r->print($Ptr);
1.5       minaeibi 1895: 
1.27      stredwic 1896:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
                   1897:         $r->print('<html><body>Unable to tie database.</body></html>');
                   1898:         return;
1.5       minaeibi 1899:     }
                   1900: 
1.27      stredwic 1901:     my $selectedName = $cache{'StudentAssessmentStudent'};
1.29    ! stredwic 1902:     for(my $index=0; 
        !          1903:         ($selectedName ne 'All Students') && ($index<(scalar @$students)); 
        !          1904:         $index++) {
        !          1905:         my $fullname = $cache{$students->[$index].':fullname'};
        !          1906:         if($fullname eq $selectedName) {
1.27      stredwic 1907:             if($cache{'StudentAssessmentMove'} eq 'next') {
                   1908:                 if($index == ((scalar @$students) - 1)) {
1.29    ! stredwic 1909:                     $selectedName = $students->[0];
1.27      stredwic 1910:                 } else {
1.29    ! stredwic 1911:                     $selectedName = $students->[$index+1];
1.27      stredwic 1912:                 }
                   1913:             } elsif($cache{'StudentAssessmentMove'} eq 'previous') {
                   1914:                 if($index == 0) {
1.29    ! stredwic 1915:                     $selectedName = $students->[-1];
1.27      stredwic 1916:                 } else {
1.29    ! stredwic 1917:                     $selectedName = $students->[$index-1];
1.27      stredwic 1918:                 }
1.29    ! stredwic 1919:             } else {
        !          1920:                 $selectedName = $students->[$index];
1.27      stredwic 1921:             }
                   1922:             last;
                   1923:         }
1.1       albertel 1924:     }
1.27      stredwic 1925: 
1.29    ! stredwic 1926:     $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
        !          1927:     $Ptr .= '<td align="left">';
        !          1928:     $Ptr .= &Apache::lonhtmlcommon::MapOptions(\%cache, 'StudentAssessment');
        !          1929:     $Ptr .= '</td></tr>'."\n";
        !          1930:     $Ptr .= '<tr><td align="right"><b>Select Student</b></td>'."\n";
        !          1931:     $Ptr .= '<td align="left">'."\n";
        !          1932:     $Ptr .= &Apache::lonhtmlcommon::StudentOptions(\%cache, $students, 
        !          1933:                                                    $selectedName, 
        !          1934:                                                    'StudentAssessment');
        !          1935:     $Ptr .= '</td></tr>'."\n";
        !          1936:     untie(%cache);
1.27      stredwic 1937: 
1.29    ! stredwic 1938:     $Ptr .= '<tr><td></td><td align="left">';
1.27      stredwic 1939:     $Ptr .= '<input type="submit" name="CreateStudentAssessment" ';
                   1940:     $Ptr .= 'value="Create Student Report" />';
                   1941:     $Ptr .= '&nbsp&nbsp&nbsp';
                   1942:     $Ptr .= '<input type="submit" name="PreviousStudent" ';
                   1943:     $Ptr .= 'value="Previous Student" />';
                   1944:     $Ptr .= '&nbsp&nbsp&nbsp';
                   1945:     $Ptr .= '<input type="submit" name="NextStudent" ';
                   1946:     $Ptr .= 'value="Next Student" />';
                   1947:     $Ptr .= '&nbsp&nbsp&nbsp';
1.29    ! stredwic 1948:     $Ptr .= '</td></tr></tbody></table>'."\n";
1.27      stredwic 1949:     $r->print($Ptr);
                   1950: 
                   1951:     if($selectedName eq 'No Student Selected') {
                   1952: 	$r->print('<h3><font color=blue>WARNING: ');
                   1953:         $r->print('Please select a student</font></h3>');
                   1954:         return;
1.1       albertel 1955:     }
                   1956: 
1.29    ! stredwic 1957:     my $selected=0;
1.27      stredwic 1958:     foreach (@$students) {
1.29    ! stredwic 1959:         next if ($_ ne $selectedName && 
        !          1960:                  $selectedName ne 'All Students');
        !          1961:         $selected = 1;
        !          1962:         my $courseData = 
        !          1963:             &Apache::loncoursedata::DownloadStudentCourseInformation($_, 
        !          1964:                                                                     $courseID);
        !          1965:         last if ($c->aborted());
        !          1966:         if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT,0640)) {
        !          1967:             &Apache::loncoursedata::ProcessStudentData(\%cache, 
        !          1968:                                                        $courseData, $_);
        !          1969:             if(!$c->aborted()) { $r->print(&StudentReport(\%cache, $_)); }
        !          1970:             untie(%cache);
1.27      stredwic 1971:         }
                   1972:     }
1.29    ! stredwic 1973:     if($selected == 0) {
        !          1974: 	$r->print('<h3><font color=blue>WARNING: ');
        !          1975:         $r->print('Please select a student</font></h3>');
1.27      stredwic 1976:         return;
                   1977:     }
1.1       albertel 1978: 
1.29    ! stredwic 1979:     return;
        !          1980: }
        !          1981: 
        !          1982: sub BuildClasslist {
        !          1983:     my ($cacheDB,$students,$studentInformation,$headings,$spacePadding)=@_;
        !          1984: 
        !          1985:     my %cache;
        !          1986:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
        !          1987:         return '<html><body>Unable to tie database.</body></html>';
1.1       albertel 1988:     }
                   1989: 
1.29    ! stredwic 1990:     my $Str='';
        !          1991:     $Str .= '<table border="0"><tr><td bgcolor="#777777">'."\n";
        !          1992:     $Str .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
        !          1993: 
        !          1994:     my $displayString = '<td align="left"><a href="/adm/statistics?';
        !          1995:     $displayString .= 'sort=LINKDATA">DISPLAYDATA&nbsp</a></td>'."\n";
        !          1996:     $Str .= &Apache::lonhtmlcommon::CreateStudentInformationHeadings(\%cache,
        !          1997:                                                            $studentInformation,
        !          1998:                                                            $headings,
        !          1999:                                                            $displayString);
        !          2000:     $Str .= '<td align="left">';
        !          2001:     $Str .= '<a href="/adm/statistics?sort=lastDownloadTime">';
        !          2002:     $Str .= 'Last Updated&nbsp&nbsp</a></td>'."\n";
        !          2003:     $Str .= '</tr>'."\n";
        !          2004:     my $alternate=0;
        !          2005:     foreach (@$students) {
        !          2006:         my ($username, $domain) = split(':', $_);
        !          2007:         if($alternate) {
        !          2008:             $Str .= '<tr bgcolor="#ffffe6"><td>';
        !          2009:         } else {
        !          2010:             $Str .= '<tr bgcolor="#ffffc6"><td>';
        !          2011:         }
        !          2012:         $alternate = ($alternate + 1) % 2;
        !          2013:         foreach my $data (@$studentInformation) {
        !          2014:             if($data eq 'fullname') {
        !          2015:                 $Str .= '<a href="/adm/statistics?reportSelected=';
        !          2016:                 $Str .= &Apache::lonnet::escape('Student Assessment').'">';
        !          2017:             }
        !          2018: 
        !          2019:             $Str .= $cache{$_.':'.$data}.'&nbsp';
        !          2020: 
        !          2021:             if($data eq 'fullname') {
        !          2022:                 $Str .= '</a>';
        !          2023:             }
        !          2024: 
        !          2025:             $Str .= '</td><td>';
        !          2026:         }
        !          2027: 
        !          2028:         $Str .= '<a href="/adm/statistics?download='.$_.'">';
        !          2029:         my $downloadTime = $cache{$_.':lastDownloadTime'};
        !          2030:         if($downloadTime ne 'Not downloaded') {
        !          2031:             $downloadTime = localtime($downloadTime);
        !          2032:         }
        !          2033:         $Str .= $downloadTime;
        !          2034: 
        !          2035:         $Str .= '&nbsp</a></td></tr>'."\n";
1.1       albertel 2036:     }
1.29    ! stredwic 2037: 
        !          2038:     $Str .= '</table></td></tr></table>'."\n";
        !          2039: 
1.27      stredwic 2040:     untie(%cache);
1.1       albertel 2041: 
1.29    ! stredwic 2042:     return $Str;
1.1       albertel 2043: }
                   2044: 
1.29    ! stredwic 2045: sub BuildStatistics {
        !          2046:     my ($r)=@_;
        !          2047: 
        !          2048:     my $c = $r->connection;
        !          2049:     my @studentInformation=('fullname','section','id','domain','username');
        !          2050:     my @headings=('Full Name', 'Section', 'PID', 'Domain', 'User Name');
        !          2051:     my $spacePadding = '   ';
        !          2052:     my %reports = ('classlist'          => 'Class list',
        !          2053:                    'problem_statistics' => 'Problem Statistics',
        !          2054:                    'student_assessment' => 'Student Assessment',
        !          2055:                    'reportSelected'     => 'Class list');
1.27      stredwic 2056: 
                   2057:     my %cache;
1.29    ! stredwic 2058:     my $courseID=$ENV{'request.course.id'};
        !          2059:     my $cacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
        !          2060:                   "_$ENV{'user.domain'}_$courseID\_statistics.db";
        !          2061: 
        !          2062:     &setbgcolor(0);
        !          2063:     my ($returnValue, $students) = &PrepareData($c, $cacheDB);
        !          2064:     if($returnValue ne 'OK') {
        !          2065:         $r->print('<html><body>'.$returnValue."\n".'</body></html>');
        !          2066:         return OK;
        !          2067:     }
        !          2068: 
        !          2069:     my $GoToPage;
        !          2070:     if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
        !          2071:         $GoToPage = $cache{'reportSelected'};
        !          2072:         $reports{'reportSelected'} = $cache{'reportSelected'};
        !          2073: #        if(defined($cache{'reportKey'}) && $cache{'reportKey'} ne 'false') {
        !          2074: #            $reports{$cache{'reportKey'}} = $cache{'reportSelected'};
        !          2075: #        }
        !          2076: 
        !          2077:         if(defined($cache{'OptionResponses'})) {
        !          2078:             $reports{'problem_analysis'} = 'Problem Analysis';
        !          2079:         }
        !          2080: 
        !          2081:         $r->print(&Apache::lonhtmlcommon::Title('LON-CAPA Statistics'));
        !          2082:         $r->print('<form name="Statistics" ');
        !          2083:         $r->print('method="post" action="/adm/statistics">');
        !          2084:         $r->print(&Apache::lonhtmlcommon::CreateStatisticsMainMenu(
        !          2085:                                                              $cache{'Status'}, 
        !          2086:                                                              \%reports));
        !          2087:         untie(%cache);
        !          2088:     } else {
1.27      stredwic 2089:         $r->print('<html><body>Unable to tie database.</body></html>');
1.29    ! stredwic 2090:         return OK;
        !          2091:     }
        !          2092: 
        !          2093:     if($GoToPage eq 'Activity Log') {
        !          2094:         &Activity();
        !          2095:     } elsif($GoToPage eq 'Problem Statistics') {
        !          2096:         &BuildProblemStatisticsPage($cacheDB, $students, $courseID, $c);
        !          2097:     } elsif($GoToPage eq 'Problem Analysis') {
        !          2098:         &BuildProblemAnalysisPage($cacheDB);
        !          2099:     } elsif($GoToPage eq 'Student Assessment') {
        !          2100:         &BuildStudentAssessmentPage($cacheDB, $students, $courseID, $c);
        !          2101:     } elsif($GoToPage eq 'Analyze') {
        !          2102:         &BuildAnalyzePage($cacheDB, $students, $courseID);
        !          2103:     } elsif($GoToPage eq 'DoDiffGraph') {
        !          2104:         &BuildDiffGraph($courseID);
        !          2105:     } elsif($GoToPage eq 'PercentWrongGraph') {
        !          2106:         &BuildWrongGraph($courseID);
        !          2107:     } elsif($GoToPage eq 'Class list') {
        !          2108:         $r->print(&BuildClasslist($cacheDB, $students, \@studentInformation,
        !          2109:                                   \@headings, $spacePadding));
1.27      stredwic 2110:     }
                   2111: 
                   2112:     $r->print('</form>'."\n");
1.29    ! stredwic 2113:     $r->print("\n".'</body>'."\n".'</html>');
        !          2114:     $r->rflush();
1.27      stredwic 2115: 
1.29    ! stredwic 2116:     return OK;
1.27      stredwic 2117: }
1.1       albertel 2118: 
                   2119: # ================================================================ Main Handler
                   2120: 
                   2121: sub handler {
                   2122:     $r=shift;
1.27      stredwic 2123:     &initial();
1.1       albertel 2124: 
1.27      stredwic 2125:     unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
                   2126:         $ENV{'user.error.msg'}=
                   2127:         $r->uri.":vgr:0:0:Cannot view grades for complete course";
                   2128:         return HTTP_NOT_ACCEPTABLE; 
                   2129:     }
                   2130: 
                   2131:     # Set document type for header only
                   2132:     if($r->header_only) {
                   2133:         if ($ENV{'browser.mathml'}) {
                   2134:             $r->content_type('text/xml');
                   2135:         } else {
                   2136:             $r->content_type('text/html');
                   2137:         }
                   2138:         &Apache::loncommon::no_cache($r);
                   2139:         $r->send_http_header;
                   2140:         return OK;
                   2141:     }
                   2142: 
                   2143:     unless($ENV{'request.course.fn'}) {
1.1       albertel 2144: 	my $requrl=$r->uri;
1.27      stredwic 2145:         $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
                   2146:         return HTTP_NOT_ACCEPTABLE; 
                   2147:     }
1.1       albertel 2148: 
1.27      stredwic 2149:     $r->content_type('text/html');
                   2150:     $r->send_http_header;
1.1       albertel 2151: 
1.29    ! stredwic 2152:     &BuildStatistics($r);
1.27      stredwic 2153: 
                   2154:     return OK;
1.1       albertel 2155: }
                   2156: 1;
                   2157: __END__

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