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