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

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

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