Annotation of loncom/interface/lonstatistics.pm, revision 1.1
1.1 ! albertel 1: # The LearningOnline Network with CAPA
! 2: # (Publication Handler
! 3: #
! 4: # $Id: lonstatistics.pm,v 1.40 2002/02/04 13:52:09 albertel Exp $
! 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
! 30: # 5/05/01, 7/09/01, 7/25/01, 8/11/01,9/13/01, 9/26/01 Behrouz Minaei
! 31: # 10/5/01, 10/9/01, 10/22/01, 10/26/01 Behrouz Minaei
! 32: # 11/1/01, 11/4/01, 11/16/01 Behrouz Minaei
! 33: # 12/14/01, 12/16/01, 12/18/01,12/20/01,12/31/01 Behrouz Minaei
! 34: # YEAR=2002
! 35: # 1/22/02,2/1/02
! 36: ###
! 37:
! 38: package Apache::lonstatistics;
! 39:
! 40: use strict;
! 41: use Apache::Constants qw(:common :http);
! 42: use Apache::lonnet();
! 43: use Apache::lonhomework;
! 44: use Apache::loncommon();
! 45: use HTML::TokeParser;
! 46: use GDBM_File;
! 47: use Benchmark;
! 48:
! 49: # -------------------------------------------------------------- Module Globals
! 50: my %hash;
! 51: my %CachData;
! 52: my %GraphDat;
! 53: my %maps;
! 54: my %section;
! 55: my %StuBox;
! 56: my %DiscFac;
! 57: my $CurMap;
! 58: my $CurSec;
! 59: my $CurStu;
! 60: my @cols;
! 61: my @list;
! 62: my @students;
! 63: my $p_count;
! 64: my $Pos;
! 65: my $r;
! 66: my $OpSel1;
! 67: my $OpSel2;
! 68: my $OpSelDis1;
! 69: my $OpSelDis2;
! 70: my $CurDis=0;
! 71: my $OpSel3;
! 72: my $OpSel4;
! 73: my $GData;
! 74: my $cid;
! 75: my $firstres;
! 76: my $lastres;
! 77: my $DiscFlag=0;
! 78:
! 79: my %Header = (0,"Problem Title",1,"#Stdnts",2,"Tries",3,"Mod",
! 80: 4,"Mean",5,"#YES",6,"#yes",7,"%Wrng",8,"S.D.",
! 81: 9,"Skew.",10,"DoDiff",11,"Map");
! 82: # 9,"Skew.",10,"DoDiff",11,"Dis.F.",12,"Resourse URL");
! 83:
! 84: my %class = ();
! 85:
! 86: my @LS;
! 87: my @LF;
! 88:
! 89: sub GetBin {
! 90: my ($Index1,$Index2,$String,$C)=@_;
! 91: my @step = 5;
! 92: my @L=($C eq 'S') ? @LS : @LF;
! 93: my $Count=$#L+1;
! 94: $r->print("<br>zone $C ------ $String ");
! 95: for(my $n=0;$n<$Count;$n++){
! 96: my @t=split(/\:/,$L[$n]);
! 97: $r->print("<br>$t[$Index1] $t[$Index2]");
! 98: }
! 99: }
! 100:
! 101: sub GetUniqe {
! 102: my ($Index,$String,$C)=@_;
! 103: my @step = 5;
! 104: my @L=($C eq 'S') ? @LS : @LF;
! 105: my $Count=$#L+1;
! 106: my @List=();
! 107: for(my $n=0;$n<$Count;$n++){
! 108: my @t=split(/\:/,$L[$n]);
! 109: push(@List,$t[$Index]);
! 110: #$r->print("<br>$t[$Index]");
! 111: }
! 112: @List = sort NumSort(@List);
! 113:
! 114: $r->print("<br>zone $C ------ $String ");
! 115: my $nIdx=0;
! 116: my $nPrb=0;
! 117: my %Proc;
! 118: undef %Proc;
! 119: while ( $nIdx < $Count ) {
! 120: my $Focus=$List[$nIdx];
! 121: my $Temp = $Focus;
! 122: do {
! 123: $nIdx++;
! 124: $nPrb++;
! 125: $Focus=$List[$nIdx];
! 126: #$Proc{$name}=$Focus;
! 127: } while ( $Focus == $Temp && $nIdx < $Count );
! 128: $r->print("<br>$Temp --> $nPrb");
! 129: $nPrb=0;
! 130: }
! 131: return %Proc;
! 132: }
! 133:
! 134: sub GetUniq {
! 135: my ($Index,$String)=@_;
! 136: my @step = 5;
! 137: my $Count=0;
! 138: my @List=();
! 139: my @temp=();
! 140: foreach (keys(%DiscFac)){
! 141: $Count++;
! 142: my @temp1=split(/\:/,$_);
! 143: @temp=($temp1[$Index],@temp1);
! 144: push(@List,join(':',@temp));
! 145: }
! 146: @List = sort NumericSort(@List);
! 147:
! 148: $r->print("<br><br>zone ($Index) ------ $String ----- / $temp[3]");
! 149: my $nIdx=0;
! 150: my $nPrb=0;
! 151: my %Proc;
! 152: undef %Proc;
! 153: while ( $nIdx < $Count ) {
! 154: my ($Focus,$Dummy,$name)=split(/\:/,$List[$nIdx]);
! 155: my $Temp = $Focus;
! 156: $Proc{$name}=$Focus;
! 157: do {
! 158: $nIdx++;
! 159: $nPrb++;
! 160: ($Focus,$Dummy,$name)=split(/\:/,$List[$nIdx]);
! 161: $Proc{$name}=$Focus;
! 162: } while ( $Focus == $Temp && $nIdx < $Count );
! 163: $r->print("<br>$Temp --> $nPrb");
! 164: $nPrb=0;
! 165: }
! 166: return %Proc;
! 167: }
! 168:
! 169: sub NumericSort {
! 170: $a <=> $b;
! 171: }
! 172:
! 173:
! 174: #------- Classification
! 175: sub Classify {
! 176: my $Count=0;
! 177: my @List=();
! 178: # foreach(keys %class){
! 179: # $r->print("<br>$_ --> $class{$_}");
! 180: # }
! 181: # $DiscFac{($DisFactor.':'.$sname.':'.$ProbTot.':'.$TotalOpend.':'.
! 182: # $TotalTries.':'.$ProbSolved.':'.$time)}=$Dis;
! 183: @LS=();
! 184: @LF=();
! 185: my $cf=0;
! 186: my $cs=0;
! 187: foreach (keys(%DiscFac)){
! 188: my @l=split(/\:/,$_);
! 189: if ($class{$l[1]}){
! 190: if( $class{$l[1]} == 4 ) {
! 191: $cs++;
! 192: push(@LS,('S:'.$l[6].':'.$l[0].':'.$l[5].':'.$l[4].':'.$l[3].':'.$class{$l[1]}));
! 193: }
! 194: elsif ( $class{$l[1]} < 3 ) {
! 195: $cf++;
! 196: push(@LF,('F:'.$l[6].':'.$l[0].':'.$l[5].':'.$l[4].':'.$l[3].':'.$class{$l[1]}));
! 197: }
! 198: }
! 199: }
! 200:
! 201: $r->print("<br>zone successful");
! 202: for(my $n=0;$n<$cs;$n++){
! 203: $r->print('<br>'.$LS[$n]);
! 204: }
! 205:
! 206: $r->print("<br>zone failed");
! 207: for(my $n=0;$n<$cf;$n++){
! 208: $r->print('<br>'.$LF[$n]);
! 209: }
! 210:
! 211: # my %Disc = &GetUniqe(@List,5,"Discrimination Factor");
! 212: # my %Opnd = &GetUniq(@List,3,"Total Opened");
! 213: # my %Trys = &GetUniq(@Lsit4,"Total Tries");
! 214: # my %Slvd = &GetUniq(5,"Problems Solved");
! 215:
! 216: # my (@L, $Index,$String)=@_;
! 217: my %Time = &GetUniqe(1,"Time",'S');
! 218: &GetUniqe(1,"Time",'F');
! 219: &GetUniqe(2,"Discrimination Factor",'S');
! 220: &GetUniqe(2,"Discrimination Factor",'F');
! 221: &GetUniqe(3,"Solved",'S');
! 222: &GetUniqe(3,"Solved",'F');
! 223: &GetUniqe(4,"Tries",'S');
! 224: &GetUniqe(4,"Tries",'F');
! 225:
! 226: &GetBin(1,2, " Time ... Discriminat",'S');
! 227: &GetBin(1,2, " Time ... Discriminat",'F');
! 228: &GetBin(1,3, " Time ... Solved",'S');
! 229: &GetBin(1,3, " Time ... Solved",'F');
! 230: &GetBin(1,4, " Time ... Tries",'S');
! 231: &GetBin(1,4, " Time ... Tries",'F');
! 232: &GetBin(2,3, " Discriminant ... Solved",'S');
! 233: &GetBin(2,3, " Discriminant ... Solved",'F');
! 234: &GetBin(2,4, " Discriminant ... Tries",'S');
! 235: &GetBin(2,4, " Discriminant ... Tries",'F');
! 236: &GetBin(3,4, " Solved ... Tries",'S');
! 237: &GetBin(3,4, " solved ... Tries",'F');
! 238: # foreach (keys(%Disc)) {
! 239: # $r->print("<br>: $Disc{$_} --> $Slvd{$_}");
! 240: # }
! 241: # $r->print("<br>..........Discriminant ... Time................");
! 242: ## foreach (keys(%Disc)) {
! 243: # $r->print("<br>$Disc{$_} --> $Time{$_}");
! 244: # }
! 245: # $r->print("<br>..........Time ... Solved.......................");
! 246: # foreach (keys(%Disc)) {
! 247: # $r->print("<br>$Disc{$_} --> $Slvd{$_}");
! 248: # }
! 249: }
! 250:
! 251: #------- Processing upperlist and lowerlist according to each problem
! 252: sub ProcessDisc {
! 253: my @List = @_;
! 254: @List = sort (@List);
! 255: my $Count = $#List+1;
! 256: my $Prb;
! 257: my @Dis;
! 258: my $Slvd=0;
! 259: my $tmp;
! 260: my $Sum=0;
! 261: my $nIdx=0;
! 262: my $nStud=0;
! 263: my %Proc;
! 264: undef %Proc;
! 265: while ($nIdx<$Count) {
! 266: ($Prb,$tmp)=split(/\=/,$List[$nIdx]);
! 267: @Dis=split(/\+/,$tmp);
! 268: my $Temp = $Prb;
! 269: do {
! 270: $nIdx++;
! 271: $nStud++;
! 272: $Sum += $Dis[$CurDis];
! 273: ($Prb,$tmp)=split(/\=/,$List[$nIdx]);
! 274: @Dis=split(/\+/,$tmp);
! 275: } while ( $Prb eq $Temp && $nIdx < $Count );
! 276: # $Proc{$Temp}=$Sum.':'.$nStud;
! 277: $Proc{$Temp}=($Sum/$nStud).':'.$nStud;
! 278: # $r->print("$nIdx) $Temp --> ($nPrb) $Proc{$Temp} <br>");
! 279: $Sum=0;
! 280: $nStud=0;
! 281: }
! 282: return %Proc;
! 283: }
! 284:
! 285: #------- Creating Discimination factor table
! 286: sub DiscriminationTable {
! 287: my $Count=0;
! 288: foreach (keys(%DiscFac)){
! 289: $Count++;
! 290: }
! 291: my $UpCnt = int(0.27*$Count);
! 292: $r->print("<br><br>".
! 293: "Current map: <b>\"$CurMap\"</b> ".
! 294: "Current Section: <b>\"$CurSec\" </b> ".
! 295: "Number of valid students: <b>$Count</b>".
! 296: "<br>The <b>Upper 27%</b> has <b>$UpCnt</b> records.".
! 297: " The <b>Lower 27%</b> has <b>$UpCnt</b> records <br>".
! 298: "The Criterion of sorting the students: ".
! 299: "<b>( Sum of Partial Credits Awarded / ".
! 300: "Total Number of Tries )</b>".
! 301: " <br><br>");
! 302: $r->rflush();
! 303: my $low=0;
! 304: my $up=$Count-$UpCnt;
! 305: my @UpList=();
! 306: my @LowList=();
! 307: $Count=0;
! 308: foreach my $key (sort(keys(%DiscFac))){
! 309: $Count++;
! 310: # $r->print("$Count) $key <br>");
! 311:
! 312: if ($low < $UpCnt || $Count > $up) {
! 313: $low++;
! 314: my $str=$DiscFac{$key};
! 315: # $r->print("$Count) $str <br>");
! 316: foreach(split(/\:/,$str)){
! 317: if ($_) {
! 318: if ($low<$UpCnt){push(@LowList,$_);}
! 319: else {push(@UpList,$_);}
! 320: }
! 321: }
! 322: }
! 323: }
! 324:
! 325: my %Up=&ProcessDisc(@UpList);
! 326: my %Low=&ProcessDisc(@LowList);
! 327:
! 328: my @list = ();
! 329: my $Useful;
! 330: my $UnUseful;
! 331: $p_count = 0;
! 332:
! 333: foreach my $key( keys %CachData) {
! 334: my @Temp=split(/\:/,$CachData{$key});
! 335: ($UnUseful,$Useful)=split(/\>/,$Temp[0]);
! 336: $list[$p_count]=$Useful.'&'.$CachData{$key};
! 337: $p_count++;
! 338: }
! 339:
! 340: @list = sort MySort (@list);
! 341:
! 342: my $Result = "\n".'<table border=2>';
! 343: $Result .= "\n".'<tr><th>P#</th>';
! 344: $Result .= "\n".'<th>'.$Header{0}.'</th>';
! 345: $Result .= "\n".'<th>'.'Discrimination Factor'.'</th>';
! 346: $Result .= "\n".'<th>'.'%Upper Award'.'</th>';
! 347: $Result .= "\n".'<th>'.'%Lower Award'.'</th>';
! 348: $Result .= "\n".'<th>'.'Upper Records'.'</th>';
! 349: $Result .= "\n".'<th>'.'Lower Records'.'</th>';
! 350: $Result .= "\n".'<th>'.'%Degree of Difficulty'.'</th>';
! 351: $Result .= "\n".'</tr>';
! 352: $r->print( $Result );
! 353:
! 354: for ( my $nIdx = 0; $nIdx < $p_count; $nIdx++ ) {
! 355: my( $Pre, $Post ) = split(/\&/,$list[$nIdx]);
! 356: my ($Temp,$MxTries,$StdNo,$TotalTries,$YES,$Override,
! 357: $Wrng,$Avg,$SD,$Sk,$DoD,$res,$Prob)=split(/\:/,$Post);
! 358: my ($UpDis,$UpNo)=split(/\:/,$Up{$Prob});
! 359: my ($LwDis,$LwNo)=split(/\:/,$Low{$Prob});
! 360: $UpNo = ($UpNo) ? $UpNo : 0;
! 361: $LwNo = ($LwNo) ? $LwNo : 0;
! 362: my $U_Dis = sprintf("%.4f", $UpDis)*100;
! 363: my $L_Dis = sprintf("%.4f", $LwDis)*100;
! 364: my $DisFac = $UpDis - $LwDis;
! 365: my $_Dis = sprintf("%.4f", $DisFac)*100;
! 366: $r->print( "\n".'<tr>'.
! 367: "\n".'<td>'.($nIdx+1).'</td>'.
! 368: "\n".'<td>'.$Temp.'</td>'.
! 369: "\n".'<td>'.$_Dis.'</td>'.
! 370: "\n".'<td>'.$U_Dis.'</td>'.
! 371: "\n".'<td>'.$L_Dis.'</td>'.
! 372: "\n".'<td>'.$UpNo.'</td>'.
! 373: "\n".'<td>'.$LwNo.'</td>'.
! 374: "\n".'<td>'.($DoD).'</td>'.
! 375: "\n".'</tr>' );
! 376: }
! 377: $r->print("\n".'</table>');
! 378: $r->rflush();
! 379: }
! 380:
! 381: sub CreateDiscFac {
! 382:
! 383: my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
! 384: "_$ENV{'user.domain'}_$cid\_statistics.db";
! 385: my $CachDisFac = "/home/httpd/perl/tmp/$ENV{'user.name'}".
! 386: "_$ENV{'user.domain'}_$cid\_DiscFactor.db";
! 387:
! 388: my $ptr='';
! 389: # $ptr .= '<br><b> Discrimination Criterion: </b>'."\n".
! 390: # '<select name="DisType"> <option '.$OpSelDis1.'> Total Numebr of Correct Answers </option>'."\n".
! 391: # '<option '.$OpSelDis2.'></option>Sum of Partial Awarded Credits / Total Number of Tries </select> '."\n";
! 392: $ptr .= '<br><input type="submit" name="sort" '.
! 393: 'value="Recalculate Discrimintion Factor" />';
! 394: $r->print($ptr);
! 395:
! 396: if ((-e "$CacheDB")&&
! 397: ($ENV{'form.sort'} ne 'Recalculate Discrimintion Factor')) {
! 398: if (tie(%CachData,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) {
! 399: tie(%DiscFac,'GDBM_File',$CachDisFac,&GDBM_READER,0640);
! 400: #&DiscriminationTable();
! 401: &Classify();
! 402: }
! 403: else {$r->print("Unable to tie hash to db file");}
! 404: }
! 405: else {
! 406: if (tie(%CachData,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) {
! 407: tie(%DiscFac,'GDBM_File',$CachDisFac,&GDBM_WRCREAT,0640);
! 408: foreach (keys %CachData) {delete $CachData{$_};}
! 409: foreach (keys %DiscFac) {delete $DiscFac{$_};}
! 410: $DiscFlag=1;
! 411: &Build_Statistics();
! 412: $DiscFlag=0;
! 413: &DiscriminationTable();
! 414: }
! 415: else {$r->print("Unable to tie hash to db file");}
! 416: }
! 417: untie(%CachData);
! 418: untie(%DiscFac);
! 419: }
! 420:
! 421:
! 422: # ------ Create different Student Report
! 423: sub StudentReport {
! 424: my ($sname,$sdom)=@_;
! 425: if ( $sname eq 'All Students' ) {
! 426: $r->print( '<h3><font color=blue>WARNING:
! 427: Please select a student</font></h3>' );
! 428: return;
! 429: }
! 430: my $shome=&Apache::lonnet::homeserver( $sname,$sdom );
! 431: my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$cid,$shome );
! 432: my %result = ();
! 433: my $ResId;
! 434: my $Code;
! 435: my $Tries;
! 436: my $TotalTries = 0;
! 437: my $ParCr = 0;
! 438: my $Wrongs;
! 439: my %TempHash;
! 440: my $Version;
! 441: my $LatestVersion;
! 442: my $PtrTry='';
! 443: my $PtrCod='';
! 444: my $SetNo=0;
! 445: my $Str = "\n".'<table border=2>'.
! 446: "\n".'<tr>'.
! 447: "\n".'<th> # </th>'.
! 448: "\n".'<th> Set Title </th>'.
! 449: "\n".'<th> Results </th>'.
! 450: "\n".'<th> Tries </th>'.
! 451: "\n".'</tr>';
! 452: unless ($reply=~/^error\:/) {
! 453: map {
! 454: my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_));
! 455: $result{$name}=$value;
! 456: } split(/\&/,$reply);;
! 457: foreach $ResId (@cols) {
! 458: if ( !$ResId ) {
! 459: my $Set=&Apache::lonnet::declutter($hash{'map_id_'.$1});
! 460: if ( $Set ) {
! 461: $SetNo++;
! 462: $Str .= "\n"."<tr>".
! 463: "\n"."<td> $SetNo </td>".
! 464: "\n"."<td> $Set </td>".
! 465: "\n"."<td> $PtrCod </td>".
! 466: "\n"."<td> $PtrTry</td>".
! 467: "\n"."</tr>";
! 468: }
! 469: $PtrTry='';
! 470: $PtrCod='';
! 471: next;
! 472: }
! 473: $ResId=~/(\d+)\.(\d+)/;
! 474: my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
! 475: if ( $CurMap ne 'All Maps' ) {
! 476: my ( $ResMap, $NameMap ) = split(/\=/,$CurMap);
! 477: if ( $Map ne $ResMap ) { next; }
! 478: }
! 479: my $meta=$hash{'src_'.$ResId};
! 480: my $PartNo = 0;
! 481: undef %TempHash;
! 482: map {
! 483: if ($_=~/^stores\_(\d+)\_tries$/) {
! 484: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
! 485: if ( $TempHash{"$Part"} eq '' ) {
! 486: $TempHash{"$Part"} = $Part;
! 487: $TempHash{$PartNo}=$Part;
! 488: $TempHash{"$Part.Code"} = '-';
! 489: $PartNo++;
! 490: }
! 491: }
! 492: } split(/\,/,&Apache::lonnet::metadata($meta,'keys'));
! 493:
! 494: my $Prob = $Map.'___'.$2.'___'.
! 495: &Apache::lonnet::declutter( $hash{'src_'.$ResId} );
! 496: $Code='U';
! 497: $Tries = 0;
! 498: $Wrongs = 0;
! 499: $LatestVersion = $result{"version:$Prob"};
! 500:
! 501: if ( $LatestVersion ) {
! 502: for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
! 503: my $vkeys = $result{"$Version:keys:$Prob"};
! 504: my @keys = split(/\:/,$vkeys);
! 505:
! 506: foreach my $Key (@keys) {
! 507: if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
! 508: my $Part = $1;
! 509: $Tries = $result{"$Version:$Prob:resource.$Part.tries"};
! 510: $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0;
! 511: $TotalTries += $Tries;
! 512: my $Val = $result{"$Version:$Prob:resource.$Part.solved"};
! 513: if ( $Val eq 'correct_by_student' )
! 514: { $Wrongs = $Tries - 1; $Code = 'Y'; }
! 515: elsif ( $Val eq 'correct_by_override' )
! 516: { $Wrongs = $Tries - 1; $Code = 'y'; }
! 517: elsif ( $Val eq 'incorrect_attempted' ||
! 518: $Val eq 'incorrect_by_override' )
! 519: { $Wrongs = $Tries; $Code = 'N'; }
! 520: $TempHash{"$Part.Code"} = $Code;
! 521: $TempHash{"$Part.Wrongs"} = $Wrongs;
! 522: }
! 523: }
! 524: }
! 525: for ( my $n = 0; $n < $PartNo; $n++ ) {
! 526: my $part = $TempHash{$n};
! 527: if ($PtrTry ne '') {$PtrTry .= ',';}
! 528: $PtrTry .= "$TempHash{$part.'.Tries'}";
! 529: $PtrCod .= "$TempHash{$part.'.Code'}";
! 530: }
! 531: }
! 532: else {
! 533: for(my $n=0; $n<$PartNo; $n++) {
! 534: if ($PtrTry ne '') {$PtrTry .= ',';}
! 535: $PtrTry .= "0";
! 536: $PtrCod .= "-";
! 537: }
! 538: }
! 539: }
! 540: }
! 541: $Str .= "\n".'</table>';
! 542: $r->print($Str);
! 543: $r->rflush();
! 544: }
! 545:
! 546:
! 547:
! 548:
! 549: # ------------------------------------------- Prepare Statistics Table
! 550: sub PreStatTable {
! 551: my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
! 552: "_$ENV{'user.domain'}_$cid\_statistics.db";
! 553: my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
! 554: "_$ENV{'user.domain'}_$cid\_graph.db";
! 555: my $CachDisFac = "/home/httpd/perl/tmp/$ENV{'user.name'}".
! 556: "_$ENV{'user.domain'}_$cid\_DiscFactor.db";
! 557: $r->print('<br><input type="submit" name="sort" value="Recalculate Statistics" />');
! 558:
! 559: my $Ptr = '';
! 560:
! 561: $Ptr .= '<br><b> Sorting Type: </b>'."\n".
! 562: '<select name="order"> <option '.$OpSel1.' >Ascending</option>'."\n".
! 563: '<option '.$OpSel2.'>Descending</option> </select> '."\n";
! 564: $Ptr .= ' ';
! 565: $Ptr .= '<input type="submit" name="sort" value="DoDiff Graph" />'."\n";
! 566: $Ptr .= ' ';
! 567: $Ptr .= '<input type="submit" name="sort" value="%Wrong Graph" />'."\n";
! 568:
! 569: $Ptr .= '<pre>'.
! 570: ' #Stdnts: Total Number of Students opened the problem.<br>'.
! 571: ' Tries : Total Number of Tries for solving the problem.<br>'.
! 572: ' Mod : Maximunm Number of Tries for solving the problem.<br>'.
! 573: ' Mean : Average Number of the tries. [ Tries / #Stdns ]<br>'.
! 574: ' #YES : Number of students solved the problem correctly.<br>'.
! 575: ' #yes : Number of students solved the problem by override.<br>'.
! 576: ' %Wrng : Percentage of students tried to solve the problem but still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]<br>'.
! 577: ' S.D. : Standard Deviation of the tries.[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) where Xi is every student\'s tries ]<br>'.
! 578: ' Skew. : Skewness of the students tries. [ (sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3) ]<br>'.
! 579: # ' DoDiff : Degree of Difficulty of the problem. [ Tries/(#YES+#yes+0.1) ]<br>'.
! 580: ' DoDiff : Degree of Difficulty of the problem. [ 1 - ((#YES+#yes) / Tries) ]<br>'.
! 581: # ' Dis.F. : Discrimination Factor. [ Sum of Partial Credits Awarded / Total Number of Tries in %27 upper and lower students]</b>'.
! 582: '</pre>';
! 583:
! 584: $r->print($Ptr);
! 585: $r->rflush();
! 586:
! 587: my $Result = "\n".'<table border=2>';
! 588: $Result .= '<tr><th>P#</th>'."\n";
! 589: for ( my $nIdx=0; $nIdx < 12; $nIdx++ ) {
! 590: $Result .= '<th>'.'<input type="submit" name="sort" value="'.
! 591: $Header{$nIdx}.'" />'.'</th>'."\n";
! 592: }
! 593: $Result .= "\n".'</tr>'."\n";
! 594: $r->print( $Result );
! 595: $r->rflush();
! 596:
! 597: if ((-e "$CacheDB")&&($ENV{'form.sort'} ne 'Recalculate Statistics')) {
! 598: if (tie(%CachData,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) {
! 599: tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640);
! 600: &Cache_Statistics();
! 601: }
! 602: else {
! 603: $r->print("Unable to tie hash to db file");
! 604: }
! 605: }
! 606: else {
! 607: if (tie(%CachData,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) {
! 608: tie(%DiscFac,'GDBM_File',$CachDisFac,&GDBM_WRCREAT,0640);
! 609: tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640);
! 610: foreach (keys %DiscFac) {delete $CachData{$_};}
! 611: foreach (keys %CachData) {delete $CachData{$_};}
! 612: $DiscFlag=0;
! 613: &Build_Statistics();
! 614: }
! 615: else {
! 616: $r->print("Unable to tie hash to db file");
! 617: }
! 618: }
! 619: #$r->print('Total instances of the problems : '.($p_count*($#students+1)));
! 620:
! 621: untie(%CachData);
! 622: untie(%GraphDat);
! 623: untie(%DiscFac);
! 624:
! 625: $r->print("\n".'</table>'."\n");
! 626: $r->rflush();
! 627: }
! 628:
! 629:
! 630: # ------------------------------------- Find the section of student in a course
! 631:
! 632: sub usection {
! 633: my ($udom,$unam,$courseid)=@_;
! 634: $courseid=~s/\_/\//g;
! 635: $courseid=~s/^(\w)/\/$1/;
! 636: map {
! 637: my ($key,$value)=split(/\=/,$_);
! 638: $key=&Apache::lonnet::unescape($key);
! 639: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
! 640: my $section=$1;
! 641: if ($key eq $courseid.'_st') { $section=''; }
! 642: my ($dummy,$end,$start)=split(/\_/,&Apache::lonnet::unescape($value));
! 643: $section=($section) ? $section : '(none)';
! 644: $section=(int($section)) ? int($section) : $section;
! 645: # $r->print($unam.'...'.$section.'<br>');
! 646: return $section;
! 647: }
! 648: } split(/\&/,&Apache::lonnet::reply('dump:'.$udom.':'.$unam.':roles',
! 649: &Apache::lonnet::homeserver($unam,$udom)));
! 650: return '';
! 651: }
! 652:
! 653:
! 654: # ------ Dump the Student's DB file and handling the data for statistics table
! 655:
! 656: sub ExtractStudentData {
! 657: my ($student,$coid)=@_;
! 658: my ($sname,$sdom) = split( /\:/, $student );
! 659: my $shome=&Apache::lonnet::homeserver( $sname,$sdom );
! 660: my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$coid,$shome );
! 661: my %result = ();
! 662: my $ResId;
! 663: my $Dis = '';
! 664: my $Code;
! 665: my $Tries;
! 666: my $ParCr;
! 667: my $TotalTries = 0;
! 668: my $TotalOpend = 0;
! 669: my $ProbSolved = 0;
! 670: my $ProbTot = 0;
! 671: my $TimeTot = 0;
! 672: my $TotParCr = 0;
! 673: my $Wrongs;
! 674: my %TempHash;
! 675: my $Version;
! 676: my $LatestVersion;
! 677: my $SecLimit;
! 678: my $MapLimit;
! 679: unless ($reply=~/^error\:/) {
! 680: map {
! 681: my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_));
! 682: $result{$name}=$value;
! 683: #$r->print($name.'='.$value.'<br>');
! 684: } split(/\&/,$reply);
! 685: foreach $ResId (@cols) {
! 686: if ( !$ResId ) { next; }
! 687: $ResId=~/(\d+)\.(\d+)/;
! 688: my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
! 689: if ( $CurMap ne 'All Maps' ) {
! 690: my ( $ResMap, $NameMap ) = split(/\=/,$CurMap);
! 691: if ( $Map ne $ResMap ) { next; }
! 692: }
! 693: my $meta=$hash{'src_'.$ResId};
! 694: my $PartNo = 0;
! 695: $Dis .= ':';
! 696: undef %TempHash;
! 697: map {
! 698: if ($_=~/^stores\_(\d+)\_tries$/) {
! 699: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
! 700: if ( $TempHash{"$Part"} eq '' ) {
! 701: $TempHash{"$Part"} = $Part;
! 702: $TempHash{$PartNo}=$Part;
! 703: $TempHash{"$Part.Code"} = 'U';
! 704: $PartNo++;
! 705: }
! 706: }
! 707: } split(/\,/,&Apache::lonnet::metadata($meta,'keys'));
! 708:
! 709: my $Prob = $Map.'___'.$2.'___'.
! 710: &Apache::lonnet::declutter( $hash{'src_'.$ResId} );
! 711: $Code='U';
! 712: $Tries = 0;
! 713: $ParCr = 0;
! 714: $Wrongs = 0;
! 715: $LatestVersion = $result{"version:$Prob"};
! 716:
! 717: if ( $LatestVersion ) {
! 718: for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
! 719: my $vkeys = $result{"$Version:keys:$Prob"};
! 720: my @keys = split(/\:/,$vkeys);
! 721:
! 722: foreach my $Key (@keys) {
! 723: if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
! 724: my $Part = $1;
! 725: $Tries = $result{"$Version:$Prob:resource.$Part.tries"};
! 726: $ParCr = $result{"$Version:$Prob:resource.$Part.awarded"};
! 727: my $Time = $result{"$Version:$Prob:timestamp"};
! 728: $TempHash{"$Part.Time"} = ($Time) ? $Time : 0;
! 729: $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0;
! 730: $TempHash{"$Part.ParCr"} = ($ParCr) ? $ParCr : 0;
! 731: $TotalTries += $TempHash{"$Part.Tries"};
! 732: $TotParCr += $TempHash{"$Part.ParCr"};
! 733: #$r->print($Version.'---'.$Prob.'==='.$Time.'<br>');
! 734: my $Val = $result{"$Version:$Prob:resource.$Part.solved"};
! 735: if ( $Val eq 'correct_by_student' )
! 736: { $Wrongs = $Tries - 1; $Code = 'C'; }
! 737: elsif ( $Val eq 'correct_by_override' )
! 738: { $Wrongs = $Tries - 1; $Code = 'O'; }
! 739: elsif ( $Val eq 'incorrect_attempted' ||
! 740: $Val eq 'incorrect_by_override' )
! 741: { $Wrongs = $Tries; $Code = 'I'; }
! 742: $TempHash{"$Part.Code"} = $Code;
! 743: $TempHash{"$Part.Wrongs"} = $Wrongs;
! 744: }
! 745: }
! 746: }
! 747: for ( my $n = 0; $n < $PartNo; $n++ ) {
! 748: my $part = $TempHash{$n};
! 749: my $Yes = 0;
! 750: if ( $TempHash{$part.'.Code'} eq 'C' ||
! 751: $TempHash{$part.'.Code'} eq 'O' )
! 752: {$ProbSolved++;$Yes=1;}
! 753: my $ptr = "$hash{'title_'.$ResId}";
! 754: if ( $PartNo > 1 ) {
! 755: $ptr .= " (part $part)";
! 756: $Dis .= ':';
! 757: }
! 758: my $Fac = ($TempHash{"$part.Tries"}) ?
! 759: ($TempHash{"$part.ParCr"}/$TempHash{"$part.Tries"}) : 0;
! 760: my $DisF;
! 761: if ( $Fac > 0 && $Fac < 1 ) {
! 762: $DisF = sprintf( "%.4f", $Fac );
! 763: }
! 764: else {$DisF = $Fac;}
! 765: # $DisF .= '+'.$TempHash{"$part.Time"};
! 766: $TimeTot += $TempHash{"$part.Time"};
! 767: $Dis .= $ptr.'*'.$ResId.'='.$DisF.'+'.$Yes;
! 768: $ptr .= "*$ResId:$TempHash{$part.'.Tries'}".
! 769: ":$TempHash{$part.'.Wrongs'}".
! 770: ":$TempHash{$part.'.Code'}";
! 771: #$r->print($sname.' -- '.$ptr.'--- timestamp='.$TempHash{"$part.Time"}.'<br>');
! 772: push (@list, $ptr);
! 773: $TotalOpend++;
! 774: $ProbTot++;
! 775: }
! 776: }
! 777: else {
! 778: for(my $n=0; $n<$PartNo; $n++) {
! 779: push (@list, "$hash{'title_'.$ResId}*$ResId:0:0:U");
! 780: $ProbTot++;
! 781: }
! 782: }
! 783: }
! 784: if ( $TotalTries ) {
! 785: my $DisFac = ( $TotalTries ) ? ($TotParCr/$TotalTries) : 0;
! 786: # my $DisFactor = int(sprintf( "%.4f", $DisFac ) * 100);
! 787: my $DisFactor = sprintf( "%.4f", $DisFac );
! 788: my $time;
! 789: if ($ProbSolved){
! 790: $time = int(($TimeTot/$ProbSolved)/10000000);
! 791: }
! 792: $DiscFac{($DisFactor.':'.$sname.':'.$ProbTot.':'.$TotalOpend.':'.
! 793: $TotalTries.':'.$ProbSolved.':'.$time)}=$Dis;
! 794: #$r->print($DisFactor.$sname.'<br> --- Dis= '.$Dis.'<br>');
! 795: }
! 796: }
! 797: #$r->print($sname.' PrCr= '.$TotParCr.' Slvd= '.$ProbSolved.' Tries='.$TotalTries.'<br>');
! 798: }
! 799:
! 800:
! 801: # ------------------------------------------------------------ Build page table
! 802: sub tracetable {
! 803: my ($rid,$beenhere)=@_;
! 804: $rid=~/(\d+)\.(\d+)/;
! 805: $maps{&Apache::lonnet::declutter($hash{'map_id_'.$1})}='';#$hash{'title_'.$rid};
! 806: unless ($beenhere=~/\&$rid\&/) {
! 807: $beenhere.=$rid.'&';
! 808: if (defined($hash{'is_map_'.$rid})) {
! 809: my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}};
! 810: if ( $cmap eq 'sequence' || $cmap eq 'page' ) {
! 811: $cols[$#cols+1]=0;
! 812: #$maps{&Apache::lonnet::declutter($hash{'src_'.$rid})}=
! 813: # $hash{'title_'.$rid};
! 814: }
! 815: if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
! 816: (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
! 817: my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
! 818:
! 819: &tracetable($hash{'map_start_'.$hash{'src_'.$rid}},
! 820: '&'.$frid.'&');
! 821:
! 822: if ($hash{'src_'.$frid}) {
! 823: if ($hash{'src_'.$frid}=~
! 824: /\.(problem|exam|quiz|assess|survey|form)$/) {
! 825: $cols[$#cols+1]=$frid;
! 826: }
! 827: }
! 828: }
! 829: } else {
! 830: if ($hash{'src_'.$rid}) {
! 831: if ($hash{'src_'.$rid}=~
! 832: /\.(problem|exam|quiz|assess|survey|form)$/) {
! 833: $cols[$#cols+1]=$rid;
! 834: }
! 835: }
! 836: }
! 837: if (defined($hash{'to_'.$rid})) {
! 838: map {
! 839: &tracetable($hash{'goesto_'.$_},$beenhere);
! 840: } split(/\,/,$hash{'to_'.$rid});
! 841: }
! 842: }
! 843: }
! 844:
! 845: sub MySort {
! 846: if ( $Pos > 0 && $Pos < 11 ) {
! 847: if ($ENV{'form.order'} eq 'Descending') {$b <=> $a;}
! 848: else { $a <=> $b; }
! 849: }
! 850: else {
! 851: if ($ENV{'form.order'} eq 'Descending') {$b cmp $a;}
! 852: else { $a cmp $b; }
! 853: }
! 854: }
! 855:
! 856: sub Build_Statistics {
! 857: $r->print(<<ENDPOP);
! 858: <script>
! 859: popwin=open('','popwin','width=400,height=100');
! 860: popwin.document.writeln('<html><body bgcolor="#8cee8c">'+
! 861: '<title>LON-CAPA Statistics</title>'+
! 862: '<h4>Computation Progress</h4>'+
! 863: '<form name=popremain>'+
! 864: '<input type=text size=35 name=remaining value=Starting></form>'+
! 865: '</body></html>');
! 866: popwin.document.close();
! 867: </script>
! 868: ENDPOP
! 869:
! 870: $r->rflush();
! 871: # ---------------------------- Gathering the Data of students' tries
! 872: my $index;
! 873: for ($index=0;$index<=$#students;$index++) {
! 874: #----------- update progress
! 875: $r->print('<script>popwin.document.popremain.remaining.value="'.
! 876: 'Computing '.($index+1).'/'.($#students+1).': '.
! 877: $students[$index].'";</script>');
! 878: $r->rflush();
! 879:
! 880: &ExtractStudentData($students[$index],$cid);
! 881: }
! 882: #--------------------- close Progress Line
! 883: $r->print('<script>popwin.close()</script>');
! 884: $r->rflush();
! 885: # -------------------- sorting the Data
! 886: @list = sort(@list);
! 887: $OpSel2='';
! 888: $OpSel1='selected';
! 889:
! 890: $p_count = 0;
! 891: my $nIdx = 0;
! 892: my $dummy;
! 893: my $p_val;
! 894: my $ResId;
! 895: my $NoElements = $#list + 1;
! 896: #-------------------------------- loop for data representation
! 897: while ( $nIdx < $NoElements ) {
! 898: my %storestats=();
! 899: my ($Prob,$Tries,$Wrongs,$Code)=split(/\:/,$list[$nIdx]);
! 900: my $Temp = $Prob;
! 901: my $MxTries = 0;
! 902: my $TotalTries = 0;
! 903: my $YES = 0;
! 904: my $Incorrect = 0;
! 905: my $Override = 0;
! 906: my $StdNo = 0;
! 907: my @StdLst;
! 908: do {
! 909: $nIdx++;
! 910: $StdNo++;
! 911: $StdLst[ $StdNo ] = $Tries;
! 912: $TotalTries += $Tries;
! 913: if ( $MxTries < $Tries ) { $MxTries = $Tries; }
! 914: if ( $Code eq 'C' ){ $YES++; }
! 915: elsif( $Code eq 'I' ) { $Incorrect++; }
! 916: elsif( $Code eq 'O' ) { $Override++; }
! 917: elsif( $Code eq 'U' ) { $StdNo--; }
! 918: ($Prob,$Tries,$Wrongs,$Code)=split(/\:/,$list[$nIdx]);
! 919: } while ( $Prob eq $Temp && $nIdx < $NoElements );
! 920:
! 921: $p_count++;
! 922:
! 923: ($Temp,$ResId)=split(/\*/,$Temp);
! 924:
! 925: $Temp = '<a href="'.$hash{'src_'.$ResId}.'" target="_blank">'.$Temp.'</a>';
! 926:
! 927: my $res = &Apache::lonnet::declutter($hash{'src_'.$ResId});
! 928: my $urlres=$res;
! 929:
! 930: $ResId=~/(\d+)\.(\d+)/;
! 931: my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
! 932: $urlres=$Map;
! 933:
! 934:
! 935: $res = '<a href="'.$hash{'src_'.$ResId}.'">'.$res.'</a>';
! 936:
! 937: #$Map = '<a href="'.$Map.'">'.$res.'</a>';
! 938:
! 939: #------------------------ Compute the Average of Tries about one problem
! 940: my $Average = ($StdNo) ? $TotalTries/$StdNo : 0;
! 941:
! 942: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___timestamp'}=time;
! 943: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___stdno'}=$StdNo;
! 944: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___avetries'}=$Average;
! 945:
! 946: #-------------------------------- Compute percentage of Wrong tries
! 947: my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0;
! 948:
! 949: #-------------------------------- Compute Standard Deviation
! 950: my $StdDev = 0;
! 951: if ( $StdNo > 1 ) {
! 952: for ( my $n = 0; $n < $StdNo; $n++ ) {
! 953: my $Dif = $StdLst[ $n ]-$Average;
! 954: $StdDev += $Dif*$Dif;
! 955: }
! 956: $StdDev /= ( $StdNo - 1 );
! 957: $StdDev = sqrt( $StdDev );
! 958: }
! 959:
! 960: #-------------------------------- Compute Degree of Difficulty
! 961: my $DoDiff = 0;
! 962: if( $TotalTries > 0 ) {
! 963: $DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries );
! 964: # $DoDiff = ($TotalTries)/($YES + $Override+ 0.1);
! 965: }
! 966:
! 967: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff;
! 968:
! 969: #-------------------------------- Compute the Skewness
! 970: my $Skewness = 0;
! 971: my $Sum = 0;
! 972: if ( $StdNo > 0 && $StdDev > 0 ) {
! 973: for ( my $n = 0; $n < $StdNo; $n++ ) {
! 974: my $Dif = $StdLst[ $n ]-$Average;
! 975: $Skewness += $Dif*$Dif*$Dif;
! 976: }
! 977: $Skewness /= $StdNo;
! 978: $Skewness /= $StdDev*$StdDev*$StdDev;
! 979: }
! 980: #----------------- Some restition in presenting the float numbers
! 981: my $Avg = sprintf( "%.2f", $Average );
! 982: my $Wrng = sprintf( "%.1f", $Wrong );
! 983: my $SD = sprintf( "%.1f", $StdDev );
! 984: my $DoD = sprintf( "%.2f", $DoDiff );
! 985: my $Sk = sprintf( "%.1f", $Skewness );
! 986:
! 987: $CachData{($p_count-1)}=$Temp.':'.$StdNo.':'.$TotalTries.':'.
! 988: $MxTries.':'.$Avg.':'.$YES.':'.
! 989: $Override.':'.$Wrng.':'.$SD.':'.
! 990: $Sk.':'.$DoD.':'.$Map.':'.$Prob;
! 991:
! 992: $urlres=~/^(\w+)\/(\w+)/;
! 993: if ($StdNo) {
! 994: &Apache::lonnet::put('resevaldata',\%storestats,$1,$2);
! 995: }
! 996:
! 997: #-------------------------------- Row of statistical table
! 998: if ( $DiscFlag == 0 ) {
! 999: $r->print( "\n".'<tr>'.
! 1000: "\n".'<td>'.$p_count.'</td>'.
! 1001: "\n".'<td>'.$Temp.'</td>'.
! 1002: "\n".'<td>'.$StdNo.'</td>'.
! 1003: "\n".'<td>'.$TotalTries.'</td>'.
! 1004: "\n".'<td>'.$MxTries.'</td>'.
! 1005: "\n".'<td>'.$Avg.'</td>'.
! 1006: "\n".'<td>'.$YES.'</td>'.
! 1007: "\n".'<td>'.$Override.'</td>'.
! 1008: "\n".'<td>'.$Wrng.'</td>'.
! 1009: "\n".'<td>'.$SD.'</td>'.
! 1010: "\n".'<td>'.$Sk.'</td>'.
! 1011: "\n".'<td>'.$DoD.'</td>'.
! 1012: "\n".'<td>'.$Map.'</td>'.
! 1013: "\n".'</tr>' );
! 1014: $GraphDat{$nIdx}=$DoD.':'.$Wrng;
! 1015: }
! 1016: }
! 1017: }
! 1018:
! 1019:
! 1020: sub Cache_Statistics {
! 1021: my @list = ();
! 1022: my $Useful;
! 1023: my $UnUseful;
! 1024: my %myHeader = reverse( %Header );
! 1025: $Pos = $myHeader{$ENV{'form.sort'}};
! 1026: $p_count = 0;
! 1027:
! 1028: foreach my $key( keys %CachData) {
! 1029: my @Temp=split(/\:/,$CachData{$key});
! 1030: if ( $Pos == 0 || $Pos == 11 ) {
! 1031: ($UnUseful,$Useful)=split(/\>/,$Temp[$Pos]);
! 1032: }
! 1033: else {
! 1034: $Useful = $Temp[$Pos];
! 1035: }
! 1036: $list[$p_count]=$Useful.'&'.$CachData{$key};
! 1037: $p_count++;
! 1038: }
! 1039:
! 1040: @list = sort MySort (@list);
! 1041:
! 1042: for ( my $nIdx = 0; $nIdx < $p_count; $nIdx++ ) {
! 1043: my( $Pre, $Post ) = split(/\&/,$list[$nIdx]);
! 1044: my ($Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,
! 1045: $Override,$Wrng,$SD,$Sk,$DoD,$res,$Prob)=split(/\:/,$Post);
! 1046: $r->print( "\n".'<tr>'.
! 1047: "\n".'<td>'.($nIdx+1).'</td>'.
! 1048: "\n".'<td>'.$Temp.'</td>'.
! 1049: "\n".'<td>'.$StdNo.'</td>'.
! 1050: "\n".'<td>'.$TotalTries.'</td>'.
! 1051: "\n".'<td>'.$MxTries.'</td>'.
! 1052: "\n".'<td>'.$Avg.'</td>'.
! 1053: "\n".'<td>'.$YES.'</td>'.
! 1054: "\n".'<td>'.$Override.'</td>'.
! 1055: "\n".'<td>'.$Wrng.'</td>'.
! 1056: "\n".'<td>'.$SD.'</td>'.
! 1057: "\n".'<td>'.$Sk.'</td>'.
! 1058: "\n".'<td>'.$DoD.'</td>'.
! 1059: "\n".'<td>'.$res.'</td>'.
! 1060: "\n".'</tr>' );
! 1061: $GraphDat{$nIdx}=$DoD.':'.$Wrng;
! 1062: }
! 1063: }
! 1064:
! 1065: # ------------------------------------------- Prepare data for Graphical chart
! 1066:
! 1067: sub GetGraphData {
! 1068: my $Tag = shift;
! 1069: my $Col;
! 1070: my $data='';
! 1071: my $count = 0;
! 1072: my $Max = 0;
! 1073: my $cid=$ENV{'request.course.id'};
! 1074: my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
! 1075: "_$ENV{'user.domain'}_$cid\_graph.db";
! 1076: foreach (keys %GraphDat) {delete $GraphDat{$_};}
! 1077: if (-e "$GraphDB") {
! 1078: if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) {
! 1079: if ( $Tag eq 'DoDiff Graph' ) {
! 1080: $Tag = 'Degree-of-Difficulty';
! 1081: $Col = 0;
! 1082: }
! 1083: else {
! 1084: $Tag = 'Wrong-Percentage';
! 1085: $Col = 1;
! 1086: }
! 1087: foreach (sort NumericSort keys %GraphDat) {
! 1088: my @Temp=split(/\:/,$GraphDat{$_});
! 1089: my $inf = $Temp[$Col];
! 1090: if ( $Max < $inf ) {$Max = $inf;}
! 1091: $data .= $inf.',';
! 1092: $count++;
! 1093: }
! 1094: untie(%GraphDat);
! 1095: my $Course = $ENV{'course.'.$cid.'.description'};
! 1096: $Course =~ s/\ /"_"/eg;
! 1097: $GData=$Course.'&'.$Tag.'&'.$Max.'&'.$count.'&'.$data;
! 1098:
! 1099: }
! 1100: else {
! 1101: $r->print("Unable to tie hash to db file");
! 1102: }
! 1103: }
! 1104: }
! 1105:
! 1106:
! 1107: sub initial {
! 1108: # --------------------------------- Initialize the global varaibles
! 1109: undef @students;
! 1110: undef @cols;
! 1111: undef %maps;
! 1112: undef %section;
! 1113: undef %StuBox;
! 1114: undef @list;
! 1115: undef %CachData;
! 1116: undef %GraphDat;
! 1117: undef %DiscFac;
! 1118: undef $CurMap;
! 1119: undef $CurSec;
! 1120: undef $CurStu;
! 1121: undef $p_count;
! 1122: undef $Pos;
! 1123: undef $GData;
! 1124: }
! 1125:
! 1126:
! 1127: sub ClassList {
! 1128:
! 1129: &GetStatus();
! 1130:
! 1131: $cid=$ENV{'request.course.id'};
! 1132: my $chome=$ENV{'course.'.$cid.'.home'};
! 1133: my ($cdom,$cnum)=split(/\_/,$cid);
! 1134: # ----------------------- Get first and last resource, see if there is anything
! 1135: $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
! 1136: $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
! 1137: if (($firstres) && ($lastres)) {
! 1138: # ----------------------------------------------------------------- Render page
! 1139: my $classlst=&Apache::lonnet::reply
! 1140: ('dump:'.$cdom.':'.$cnum.':classlist',$chome);
! 1141: my $StudNo = 0;
! 1142: unless ($classlst=~/^error\:/) {
! 1143: foreach (sort split(/\&/,$classlst)) {
! 1144: my ($name,$value)=split(/\=/,$_);
! 1145: my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
! 1146: $name=&Apache::lonnet::unescape($name);
! 1147: my ($sname,$sdom)=split(/\:/,$name);
! 1148: my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
! 1149: if ($ssec==-1) {next;}
! 1150: $ssec=($ssec) ? $ssec : '(none)';
! 1151: $ssec=(int($ssec)) ? int($ssec) : $ssec;
! 1152: #$r->print($sname.'...'.$ssec.'<br>');
! 1153: $section{$ssec}=$ssec;
! 1154: if ($CurSec eq 'All Sections' || $ssec eq $CurSec) {
! 1155: $students[$StudNo]=$name;
! 1156: $StuBox{$sname}=$ssec;
! 1157: }
! 1158: $StudNo++;
! 1159: }
! 1160: }
! 1161: else {
! 1162: $r->print('<h1>Could not access course data</h1>');
! 1163: }
! 1164: $r->print("Total number of students : ".($#students+1));
! 1165: $r->rflush();
! 1166: # --------------- Find all assessments and put them into some linear-like order
! 1167: &tracetable($firstres,'&'.$lastres.'&');
! 1168: }
! 1169:
! 1170: # ------------------------------------------------------------- End render page
! 1171: else {
! 1172: $r->print('<h3>Undefined course sequence</h3>');
! 1173: }
! 1174: &MapSecOptions();
! 1175: }
! 1176:
! 1177:
! 1178: sub Menu {
! 1179: my $InpStr = $ENV{'form.sort'};
! 1180: if ( $InpStr eq 'DoDiff Graph' || $InpStr eq '%Wrong Graph' ) {
! 1181: &GetGraphData($InpStr);
! 1182: $r->print('<IMG src="/cgi-bin/graph.gif?'.$GData.'" />');
! 1183: }
! 1184: else {
! 1185: $r->print('<html><head><title>LON-CAPA Statistics</title></head>');
! 1186:
! 1187:
! 1188: $r->print('<body bgcolor="#FFFFFF">'.
! 1189: '<script>window.focus(); window.width=500;window.height=500; </script>'.
! 1190: '<img align=right src=/adm/lonIcons/lonlogos.gif>');
! 1191: # ---------------------------------------------------------------- Course title
! 1192: $r->print('<h1> Course : "'.
! 1193: $ENV{'course.'.$ENV{'request.course.id'}.
! 1194: '.description'}.'"</h1><h2>'.localtime().'</h2>');
! 1195: # ------------------------------- This is going to take a while, produce output
! 1196: $r->rflush();
! 1197:
! 1198: $r->print("\n".'<form name=stat method=post action="/adm/statistics" >');
! 1199:
! 1200: my $content = $ENV{'form.sort'};
! 1201: if ($content eq '' || $content eq 'Return to Menu') {
! 1202: my $Ptr = '<h3>';
! 1203: $Ptr .= '<input type=submit name=sort value="Problem Evaluation"/>';#General Statistics"/>';
! 1204: $Ptr .= '<br><br>';
! 1205: $Ptr .= '<input type=submit name=sort value="Student Assessment"/>';
! 1206: $Ptr .= '<br><br>';
! 1207: # $Ptr .= '<input type=submit name=sort value=Discrimination>';#"Problem Evaluation"/>';
! 1208: $Ptr .= '</h3>';
! 1209: $r->print( $Ptr );
! 1210: }
! 1211: else {
! 1212: &initial();
! 1213: &ClassList();
! 1214: if ( $content eq 'Discrimination' || #'Problem Evaluation' ||
! 1215: $content eq 'Recalculate Discrimintion Factor' ) {
! 1216: &CreateDiscFac();
! 1217: }
! 1218: elsif ( $content eq 'Student Assessment' ||
! 1219: $content eq 'Create Student Report' ) {
! 1220: &StudentOptions();
! 1221: &StudentReport($CurStu,$StuBox{"$CurStu"});
! 1222: }
! 1223: else {
! 1224: &PreStatTable();
! 1225: }
! 1226: }
! 1227: $r->print("\n".'</form>'.
! 1228: "\n".'</body>'.
! 1229: "\n".'</html>');
! 1230: $r->rflush();
! 1231: }
! 1232: }
! 1233:
! 1234: sub StudentOptions {
! 1235: my $OpSel5='';
! 1236: $CurStu = $ENV{'form.student'};
! 1237: if ( $CurStu eq '' ) {
! 1238: $CurStu = 'All Students';
! 1239: $OpSel5 = 'selected';
! 1240: }
! 1241: my $Ptr ='';
! 1242: # ----------------------------------- Loading the Students Combobox
! 1243: $Ptr .= '<br><b>Select Student</b>'."\n".
! 1244: '<select name="student">'."\n".
! 1245: '<option '.$OpSel5.'>All Students</option>';
! 1246: foreach my $key ( sort keys %StuBox ) {
! 1247: $Ptr .= '<option';
! 1248: if ($CurStu eq $key) {$Ptr .= ' selected';}
! 1249: $Ptr .= '>'.$key."</option>\n";
! 1250: }
! 1251: $Ptr .= '</select>';
! 1252: $Ptr .= '<br><input type="submit" name="sort" value="Create Student Report" />';
! 1253: $r->print( $Ptr );
! 1254: $r->rflush();
! 1255: }
! 1256:
! 1257: sub GetStatus {
! 1258:
! 1259: $OpSelDis1='';
! 1260: $OpSelDis2='';
! 1261: $OpSel1='';
! 1262: $OpSel2='';
! 1263: $OpSel3='';
! 1264: $OpSel4='';
! 1265:
! 1266: # if ( $ENV{'form.DisType'} eq 'Total Number of Correct Answers' ) {
! 1267: # $OpSelDis1='selected';
! 1268: # $CurDis=0;
! 1269: # }
! 1270: # else { $OpSel2 = 'selected'; $CurDis = 1;}
! 1271:
! 1272: if ( $ENV{'form.order'} eq 'Descending' ) { $OpSel2='selected'; }
! 1273: else { $OpSel1 = 'selected'; }
! 1274: $CurMap = $ENV{'form.maps'};
! 1275: if ( $CurMap eq '' ) {
! 1276: $CurMap = 'All Maps';
! 1277: $OpSel3 = 'selected';
! 1278: }
! 1279: $CurSec = $ENV{'form.section'};
! 1280: if ( $CurSec eq '' ) {
! 1281: $CurSec = 'All Sections';
! 1282: $OpSel4 = 'selected';
! 1283: }
! 1284: }
! 1285:
! 1286:
! 1287: sub MapSecOptions {
! 1288: # ----------------------------------- Loading the Maps Combobox
! 1289: my $Ptr = '<br>';
! 1290: $Ptr .= '<br><input type="submit" name="sort" value="Return to Menu" />';
! 1291: $Ptr .= '<br><b> Select Map </b>'."\n".
! 1292: '<select name="maps">'."\n".
! 1293: '<option '.$OpSel3.'>All Maps</option>';
! 1294: foreach my $key ( sort keys %maps ) {
! 1295: $Ptr .= '<option';
! 1296: if ($CurMap eq $key) {$Ptr .= ' selected';}
! 1297: $Ptr .= '>'.$key."</option>\n";
! 1298: }
! 1299: $Ptr .= '</select>';
! 1300: $Ptr .= ' ';
! 1301:
! 1302: # ----------------------------------- Loading the Sections Combobox
! 1303: $Ptr .= '<br><b>Select Section</b>'."\n".
! 1304: '<select name="section">'."\n".
! 1305: '<option '.$OpSel4.'>All Sections</option>';
! 1306: foreach my $key ( sort keys %section ) {
! 1307: $Ptr .= '<option';
! 1308: if ($CurSec eq $key) {$Ptr .= ' selected';}
! 1309: $Ptr .= '>'.$key."</option>"."\n";
! 1310: }
! 1311: $Ptr .= '</select>'."\n";
! 1312:
! 1313: $r->print( $Ptr );
! 1314: $r->rflush();
! 1315: }
! 1316:
! 1317:
! 1318: # ================================================================ Main Handler
! 1319:
! 1320: sub handler {
! 1321: $r=shift;
! 1322:
! 1323: if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
! 1324: # ------------------------------------------- Set document type for header only
! 1325: if ($r->header_only) {
! 1326: if ($ENV{'browser.mathml'}) {
! 1327: $r->content_type('text/xml');
! 1328: }
! 1329: else {
! 1330: $r->content_type('text/html');
! 1331: }
! 1332: &Apache::loncommon::no_cache($r);
! 1333: $r->send_http_header;
! 1334: return OK;
! 1335: }
! 1336: my $requrl=$r->uri;
! 1337: # ----------------------------------------------------------------- Tie db file
! 1338:
! 1339: undef %hash;
! 1340:
! 1341: if ($ENV{'request.course.fn'}) {
! 1342: my $fn=$ENV{'request.course.fn'};
! 1343: if (-e "$fn.db") {
! 1344: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
! 1345: # ------------------------------------------------------------------- Hash tied
! 1346: $r->content_type('text/html');
! 1347: $r->send_http_header;
! 1348: &Menu();
! 1349: }
! 1350: else {
! 1351: $r->content_type('text/html');
! 1352: $r->send_http_header;
! 1353: $r->print('<html><body>Coursemap undefined.</body></html>');
! 1354: }
! 1355: # ------------------------------------------------------------------ Untie hash
! 1356: unless (untie(%hash)) {
! 1357: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
! 1358: "Could not untie coursemap $fn (browse).</font>");
! 1359: }
! 1360:
! 1361: # -------------------------------------------------------------------- All done
! 1362: return OK;
! 1363: # ----------------------------------------------- Errors, hash could no be tied
! 1364: }
! 1365: }
! 1366: else {
! 1367: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
! 1368: return HTTP_NOT_ACCEPTABLE;
! 1369: }
! 1370: }
! 1371: else {
! 1372: $ENV{'user.error.msg'}=
! 1373: $r->uri.":vgr:0:0:Cannot view grades for complete course";
! 1374:
! 1375: return HTTP_NOT_ACCEPTABLE;
! 1376: }
! 1377: }
! 1378: 1;
! 1379: __END__
! 1380:
! 1381:
! 1382:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonstatistics.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface