1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
4: # $Id: lonstatistics.pm,v 1.28 2002/07/19 18:17:34 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/5,7/9,7/25/1,8/11,9/13,9/26,10/5,10/9,10/22,10/26 Behrouz Minaei
31: # 11/1,11/4,11/16,12/14,12/16,12/18,12/20,12/31 Behrouz Minaei
32: # YEAR=2002
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
34: # 5/12,5/14,5/15,5/19,5/26,7/16 Behrouz Minaei
35: #
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:
48: # -------------------------------------------------------------- Module Globals
49: my %hash;
50: my %CachData;
51: my %GraphDat;
52: my $r;
53: my $GData;
54: my %color;
55: my %foil_to_concept;
56: my @Concepts;
57: my %ConceptData;
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: }
241:
242: sub Activity {
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);
250: my $file="/home/minaeibi/activity.log";
251: my $userid='adamsde1';
252: $r->print("<br>Using $file");
253: $r->rflush();
254: open(FILEID, "<$file");
255: my $line;
256: my @allaccess;
257: my $Count=0;
258: while ($line=<FILEID>) {
259: my ($time,$machine,$what)=split(':',$line);
260: $what=&Apache::lonnet::unescape($what);
261: my @accesses=split('&',$what);
262: foreach my $access (@accesses) {
263: my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
264: #if ($who ne $userid) { next; }
265: if (!$resource) { next; }
266: my $res=&Apache::lonnet::unescape($resource);
267: if (($res =~ /\.(sequence|problem|htm|html|page)/)) {
268: $Count++;
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: # }
275: $r->rflush();
276: }
277: #push (@allaccess,unescape($access));
278: #print $machine;
279: }
280: }
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: # }
292: }
293:
294:
295: sub InitAnalysis {
296: my ($uri,$part,$problem,$student,$courseID)=@_;
297: my ($uname,$udom)=split(/\:/,$student);
298:
299:
300: # Render the student's view of the problem. $Answ is the problem
301: # Stringafied
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'));
308:
309: # (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
310: %Answer=();
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;
328: #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
329: }
330: }
331:
332: return;
333: }
334:
335:
336: sub Interval {
337: my ($part,$symb)=@_;
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;
345: }
346: $ConceptData{"Int.$Int"}=$due;
347: for (my $i=0;$i<$Int;$i++) {
348: for (my $n=0; $n<=$#Concepts; $n++ ) {
349: my $tmp=$Concepts[$n];
350: $ConceptData{"$tmp.$i.true"}=0;
351: $ConceptData{"$tmp.$i.false"}=0;
352: }
353: }
354: }
355:
356:
357: sub ShowOpGraph {
358: my ($cache, $students, $courseID)=@_;
359: my $uri = $cache->{'AnalyzeURI'};
360: my $part = $cache->{'AnalyzePart'};
361: my $problem = $cache->{'AnalyzeProblem'};
362: my $title = $cache->{'AnalyzeTitle'};
363: my $interval = $cache->{'Interval'};
364: $ConceptData{"Interval"} = $interval;
365:
366: #Initialize the option response true answers
367: &InitAnalysis($uri, $part, $problem, $students->[0],$courseID);
368:
369: #compute the intervals
370: &Interval($part,$problem);
371:
372: $title =~ s/\ /"_"/eg;
373: $r->print('<br><b>'.$uri.'</b>');
374: $r->rflush();
375:
376: #Java script Progress window
377: &Create_PrgWin();
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);
382: }
383: &Close_PrgWin();
384:
385: $r->print('<br>');
386: for (my $k=0; $k<$interval; $k++ ) {
387: &DrawGraph($k,$title);
388: }
389: for (my $k=0; $k<$interval; $k++ ) {
390: &DrawTable($k);
391: }
392: #$Apache::lonxml::debug=1;
393: #&Apache::lonhomework::showhash(%ConceptData);
394: #$Apache::lonxml::debug=0;
395: my $Answ=&Apache::lonnet::ssi($uri);
396: $r->print("<br><b>Here you can see the Problem:</b><br>$Answ");
397: }
398:
399:
400: sub DrawTable {
401: my $k=shift;
402: my $Max=0;
403: my @data1;
404: my @data2;
405: my $Correct=0;
406: my $Wrong=0;
407: for (my $n=0; $n<=$#Concepts; $n++ ) {
408: my $tmp=$Concepts[$n];
409: $data1[$n]=$ConceptData{"$tmp.$k.true"};
410: $Correct+=$data1[$n];
411: $data2[$n]=$ConceptData{"$tmp.$k.false"};
412: $Wrong+=$data2[$n];
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: }
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>';
431:
432: for (my $n=0; $n<=$#Concepts; $n++ ) {
433: $Str .= "\n"."<tr>".
434: "\n"."<td>".($n+1)."</td>".
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>".
438: "\n"."</tr>";
439: }
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);
447: #$Apache::lonxml::debug=1;
448: #&Apache::lonhomework::showhash(%ConceptData);
449: #$Apache::lonxml::debug=0;
450: }
451:
452:
453: sub DrawGraph {
454: my ($k,$Src)=@_;
455: my $Max=0;
456: my @data1;
457: my @data2;
458:
459: # Adjust Data and find the Max
460: for (my $n=0; $n<=$#Concepts; $n++ ) {
461: my $tmp=$Concepts[$n];
462: $data1[$n]=$ConceptData{"$tmp.$k.true"};
463: $data2[$n]=$ConceptData{"$tmp.$k.false"};
464: my $Sum=$data1[$n]+$data2[$n];
465: if ( $Max<$Sum ) {$Max=$Sum;}
466: }
467: for (my $n=0; $n<=$#Concepts; $n++ ) {
468: if ($data1[$n]+$data2[$n]<$Max) {
469: $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
470: }
471: }
472: my $P_No = $#data1+1;
473:
474: if ( $Max > 1 ) {
475: $Max += (10 - $Max % 10);
476: $Max = int($Max);
477: } else { $Max = 1; }
478:
479: my $Titr=($ConceptData{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
480: # $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
481: $GData="$Titr&Concepts&Answers&$Max&$P_No&".
482: (join(',',@data1)).'&'.(join(',',@data2));
483:
484: $r->print('<IMG src="/cgi-bin/graph.gif?'.$GData.'" border=1/>');
485: }
486:
487:
488: sub Decide {
489: #deciding the true or false answer belongs to each interval
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:
497: #restore the student submissions and finding the result
498: sub OpStatus {
499: my ($problem, $student, $courseID)=@_;
500: my ($username,$userdomain)=split(/':'/,$student);
501: my $code='U';
502: my %reshash=&Apache::lonnet::restore($problem, $courseID, $userdomain,
503: $username);
504: my @True = ();
505: my @False = ();
506: my $flag=0;
507: if ($reshash{'version'}) {
508: my $tries=0;
509: &Apache::lonhomework::showhash(%Answer);
510: for (my $version=1;$version<=$reshash{'version'};$version++) {
511: my $time=$reshash{"$version:timestamp"};
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"};
524: my %submission=&Apache::lonnet::str2hash($Resp);
525: foreach (keys %submission) {
526: my $Ansr = $Answer{"$Id1.$Id2.foil.value.$_"};
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: }
539:
540:
541: #---- END Analyze Web Page ----------------------------------------------
542:
543: #---- Problem Statistics Web Page ---------------------------------------
544:
545: #------- Processing upperlist and lowerlist according to each problem
546: sub ProcessDiscriminant {
547: my ($List) = @_;
548: my @sortedList = sort (@$List);
549: my $Count = scalar @sortedList;
550: my $Problem;
551: my @Dis;
552: my $Slvd=0;
553: my $tmp;
554: my $Sum1=0;
555: my $Sum2=0;
556: my $nIndex=0;
557: my $nStudent=0;
558: my %Proc=undef;
559: while ($nIndex<$Count) {
560: ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]);
561: @Dis=split(/\+/,$tmp);
562: my $Temp = $Problem;
563: do {
564: $nIndex++;
565: $nStudent++;
566: $Sum1 += $Dis[0];
567: $Sum2 += $Dis[1];
568: ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]);
569: @Dis=split(/\+/,$tmp);
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>");
574: $Sum1=0;
575: $Sum2=0;
576: $nStudent=0;
577: }
578:
579: return %Proc;
580: }
581:
582:
583:
584: #------- Creating Discimination factor
585: sub Discriminant {
586: my ($discriminantFactor)=@_;
587: my @discriminantKeys=keys(%$discriminantFactor);
588: my $Count = scalar @discriminantKeys;
589:
590: my $UpCnt = int(0.27*$Count);
591: my $low=0;
592: my $up=$Count-$UpCnt;
593: my @UpList=();
594: my @LowList=();
595:
596: $Count=0;
597: foreach my $key (sort(@discriminantKeys)) {
598: $Count++;
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: }
609: }
610: my %DisUp = &ProcessDiscriminant(\@UpList);
611: my %DisLow = &ProcessDiscriminant(\@LowList);
612:
613: return (\%DisUp, \%DisLow);
614: }
615:
616:
617: sub NumericSort {
618: $a <=> $b;
619: }
620:
621:
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.'"');
627: return;
628: }
629:
630: $r->print('<br><a href="'.$sequenceSource.
631: '" target="_blank">'.$sequenceTitle.'</a>');
632:
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";
638: }
639: $Result .= "\n".'</tr>'."\n";
640: $r->print($Result);
641: $r->rflush();
642: }
643:
644: sub CloseTable {
645: my ($cache)=@_;
646: if($cache->{'DisplayFormat'} eq 'Display CSV Format') {
647: return;
648: }
649: $r->print("\n".'</table>'."\n");
650: $r->rflush();
651: }
652:
653:
654:
655: # ------ Dump the Student's DB file and handling the data for statistics table
656: sub ExtractStudentData {
657: my ($cache,$name,$list)=@_;
658: my %discriminantFactor;
659:
660: my $totalTries = 0;
661: my $totalAwarded = 0;
662: my $tempProblemOrder=0;
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:
673: foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
674: if($cache->{'ProblemStatisticsMap'} ne 'All Maps' &&
675: $cache->{'ProblemStatisticsMap'} ne $cache->{$sequence.':title'}) {
676: next;
677: }
678:
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: }
706:
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;
724: $Discussed=0;
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: }
754:
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;
766:
767: if($_ > 1) {
768: $ptr .= "*(part $_)";
769: $Dis .= '&';
770: }
771:
772: my ($pr_no,$dod)=split('&',$ptr);
773: my $DoDiff=$DoDiff{$dod};
774: # $r->print('<br>'.$name.'---'.$ptr.'==='.$DoDiff);
775:
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: }
784:
785: if ($Discuss{"$name:$problem"}) {
786: $TotDiscuss++;
787: $Discussed=1;
788: }
789: my $time = $cache->{"$name:$LatestVersion:$problem:timestamp"};
790: $Dis .= $tempProblemOrder.'='.$DisF.'+'.$Yes;
791: $ptr .= '&'.$partData{$_.'.Tries'}.
792: '&'.$partData{$_.'.Wrongs'}.
793: '&'.$partData{$_.'.Code'};
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:
816: $tempProblemOrder++;
817: }
818: }
819: my $pstr;
820: if($totalTries) {
821: my $DisFac = ($totalAwarded/$totalTries);
822: my $DisFactor = sprintf( "%.4f", $DisFac );
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;
830: }
831: }
832:
833: return (\%discriminantFactor);
834: }
835:
836:
837: =pod
838: sub MySort {
839: if ( $Pos > 0 ) {
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: }
848: =cut
849:
850: sub BuildStatisticsTable {
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();
864:
865: my $p_count = 0;
866: my $nIndex = 0;
867: my $dummy;
868: my $p_val;
869: my $ResId;
870: my $NoElements = scalar @$list;
871:
872: foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
873: if($cache->{'ProblemStatisticsMap'} ne 'All Maps' &&
874: $cache->{'ProblemStatisticsMap'} ne $cache->{$sequence.':title'}) {
875: next;
876: }
877:
878: &CreateProblemStatisticsTableHeading($cache->{'DisplayFormat'},
879: $cache->{$sequence.':source'},
880: $cache->{$sequence.':title'},
881: $headings);
882:
883: ##777777
884: ## &Classify($discriminantFactor, $students);
885:
886:
887: my ($Hid,$pr)=split(/\:/,$mapsort{$_});
888: my @lpr=split(/\&/,$pr);
889: for (my $i=1; $i<=$#lpr; $i++) {
890: my %storestats=();
891: my ($PrOrd,$Prob,$Tries,$Wrongs,$Code,$Disc)=split(/\&/,$list->[$nIndex]);
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;
899: my $DiscNo=0;
900: my @StdLst;
901: while ( $PrOrd == $lpr[$i] )
902: {
903: $nIndex++;
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--; }
912: ($PrOrd,$Prob,$Tries,$Wrongs,$Code,$Disc)=split(/\&/,$list->[$nIndex]);
913: }
914:
915: $p_count++;
916: my $Dummy;
917: ($ResId,$Dummy)=split(/\*/,$Temp);
918:
919: $Temp = '<a href="'.$hash{'src_'.$ResId}.
920: '" target="_blank">'.$hash{'title_'.$ResId}.$Dummy.'</a>';
921:
922: my $res = &Apache::lonnet::declutter($hash{'src_'.$ResId});
923: my $urlres=$res;
924:
925: $ResId=~/(\d+)\.(\d+)/;
926: my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
927: $urlres=$Map;
928:
929: $res = '<a href="'.$hash{'src_'.$ResId}.'">'.$res.'</a>';
930: #$Map = '<a href="'.$Map.'">'.$res.'</a>';
931:
932: #------------------------ Compute the Average of Tries about one problem
933: my $Average = ($StdNo) ? $TotalTries/$StdNo : 0;
934:
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;
938:
939: #-------------------------------- Compute percentage of Wrong tries
940: my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0;
941:
942: #-------------------------------- Compute Standard Deviation
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: }
952:
953: #-------------------------------- Compute Degree of Difficulty
954: my $DoDiff = 0;
955: if( $TotalTries > 0 ) {
956: $DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries );
957: # $DoDiff = ($TotalTries)/($YES + $Override+ 0.1);
958: }
959:
960: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff;
961:
962: #-------------------------------- Compute the Skewness
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;
971: $Skewness /= $StdDev*$StdDev*$StdDev;
972: }
973:
974: #--------------------- Compute the Discrimination Factors
975: my ($Up1,$Up2)=split(/\:/,':');#jason$DisUp->{$lpr[$i]});
976: my ($Lw1,$Lw2)=split(/\:/,':');#jason$DisLow->{$lpr[$i]});
977: my $Dis1 = $Up1 - $Lw1;
978: my $Dis2 = $Up2 - $Lw2;
979: my $_D1 = sprintf("%.2f", $Dis1);
980: my $_D2 = sprintf("%.2f", $Dis2);
981:
982: #----------------- Some restition in presenting the float numbers
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 );
988: my $join = $lpr[$i].'&'.$Temp.'&'.$StdNo.'&'.
989: $TotalTries.'&'.$MxTries.'&'.$Avg.'&'.
990: $YES.'&'.$Override.'&'.$Wrng.'&'.$DoD.'&'.
991: $SD.'&'.$Sk.'&'.$_D1.'&'.$_D2.'&'.
992: $DiscNo.'&'.$Prob;
993: $CachData{($p_count-1)}=$join;
994:
995: #6666666
996: # $r->print('<br>'.$out.'&'.$DoD);
997: # print (OUT $out.'@'.$DoD.'&');
998: #6666666
999:
1000: $urlres=~/^(\w+)\/(\w+)/;
1001: if ($StdNo) {
1002: &Apache::lonnet::put('resevaldata',\%storestats,$1,$2);
1003: }
1004: #-------------------------------- Row of statistical table
1005: &TableRow($cache,$join,$i,($p_count-1));
1006: }
1007: &CloseTable($cache);
1008: }
1009: &Close_PrgWin();
1010: #666666
1011: # close( OUT );
1012: #666666
1013: }
1014:
1015: =pod
1016: sub Cache_Statistics {
1017: my ($cache)=@_;
1018: my @list = ();
1019: my $Useful;
1020: my $UnUseful;
1021: # $r->print('<input type="hidden" name="show" value="excel" />'."\n");
1022: my %myHeader = reverse( %Header );
1023: $Pos = $myHeader{$ENV{'form.sort'}};
1024: if ($Pos > 0) {$Pos++;}
1025: my $p_count = 0;
1026: foreach my $key( keys %CachData) {
1027: my @Temp=split(/\&/,$CachData{$key});
1028: if ( $Pos == 0 ) {
1029: ($UnUseful,$Useful)=split(/\>/,$Temp[$Pos]);
1030: }
1031: else {
1032: $Useful = $Temp[$Pos];
1033: }
1034: $list[$p_count]=$Useful.'@'.$CachData{$key};
1035: $p_count++;
1036: }
1037:
1038: @list = sort MySort (@list);
1039:
1040: my $nIndex=0;
1041:
1042: if ( $Pos == 0 ) {
1043: foreach (sort keys %mapsort) {
1044: my ($Hid,$pr)=split(/\:/,$mapsort{$_});
1045: &CreateProblemStatisticsTableHeading($cache,1,$Hid);
1046: my @lpr=split(/\&/,$pr);
1047: for (my $i=1; $i<=$#lpr; $i++) {
1048: my($Pre, $Post) = split(/\@/,$list[$nIndex]);
1049: #$r->print('<br>'.$Pre.'---'.$Post);
1050: &TableRow($cache,$Post,$i,$nIndex);
1051: $nIndex++;
1052: }
1053: &CloseTable($cache);
1054: }
1055: }
1056: else {
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);
1061: }
1062: &CloseTable($cache);
1063: }
1064: }
1065: =cut
1066:
1067:
1068:
1069: sub TableRow {
1070: my ($Str,$Idx,$RealIdx)=@_;
1071: my($PrOrd,$Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override,
1072: $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$DiscNo,$Prob)=split(/\&/,$Str);
1073: if ($ENV{'form.showcsv'}) {
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.'",'.
1090: "\n".'"'.$_D2.'"'.
1091: "\n".'"'.$DiscNo.'"';
1092:
1093: $r->print("\n".$Ptr);
1094: }
1095: else{
1096: my $Ptr = "\n".'<tr>'.
1097: "\n".'<td>'.($RealIdx+1).'</td>'.
1098: # "\n".'<td>'.$PrOrd.$Temp.'</td>'.
1099: "\n".'<td>'.$Temp.'</td>'.
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>'.
1111: "\n".'<td bgcolor='.$color{"purple"}.'> '.$_D2.'</td>'.
1112: "\n".'<td bgcolor='.$color{"yellow"}.'> '.$DiscNo.'</td>';
1113: $r->print("\n".$Ptr.'</tr>' );
1114: }
1115: $GraphDat{$RealIdx}=$DoD.':'.$Wrng;
1116: }
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 .= ' ';
1170: $Ptr .= '<input type="submit" name="DoDiffGraph" ';
1171: $Ptr .= 'value="DoDiff Graph" />'."\n";
1172: $Ptr .= ' ';
1173: $Ptr .= '<input type="submit" name="PercentWrongGraph" ';
1174: $Ptr .= 'value="%Wrong Graph" />'."\n";
1175: $Ptr .= ' ';
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>';
1239: $Ptr .= '</td>';
1240: $Ptr .= '<td><b>Disc.</b></td>';
1241: $Ptr .= '<td>Number of Students had at least one discussion.';
1242: $Ptr .= '</td></tr></table>';
1243:
1244: return $Ptr;
1245: }
1246:
1247: #---- END Problem Statistics Web Page ----------------------------------------
1248:
1249: #---- Problem Statistics Graph Web Page --------------------------------------
1250:
1251: # ------------------------------------------- Prepare data for Graphical chart
1252:
1253: sub GetGraphData {
1254: my $ylab = shift;
1255: my $Col;
1256: my $data='';
1257: my $count = 0;
1258: my $Max = 0;
1259: my $cid=$ENV{'request.course.id'};
1260: my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
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';
1267: $Col = 0;
1268: }
1269: else {
1270: $ylab = 'Wrong-Percentage';
1271: $Col = 1;
1272: }
1273: foreach (sort NumericSort keys %GraphDat) {
1274: my @Temp=split(/\:/,$GraphDat{$_});
1275: my $inf = $Temp[$Col];
1276: if ( $Max < $inf ) {$Max = $inf;}
1277: $data .= $inf.',';
1278: $count++;
1279: }
1280: if ( $Max > 1 ) {
1281: $Max += (10 - $Max % 10);
1282: $Max = int($Max);
1283: }
1284: else { $Max = 1; }
1285: untie(%GraphDat);
1286: my $Course = $ENV{'course.'.$cid.'.description'};
1287: $Course =~ s/\ /"_"/eg;
1288: $GData=$Course.'&'.'Problems'.'&'.$ylab.'&'.$Max.'&'.$count.'&'.$data;
1289: }
1290: else {
1291: $r->print("Unable to tie hash to db file");
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];
1699: }
1700: } else {
1701: # Sort by user name
1702: for(my $index=0; $index<scalar @sorted1Students; $index++) {
1703: $sortData{$sorted1Students[$index]}=$sorted1Students[$index];
1704: }
1705: }
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();
1810: }
1811:
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: }
1820:
1821: # close Progress Line
1822: sub Close_PrgWin {
1823: $r->print('<script>popwin.close()</script>');
1824: $r->rflush();
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: }
1844:
1845: return;
1846: }
1847:
1848: sub initial {
1849: undef %hash;
1850: undef %CachData;
1851: undef %GraphDat;
1852: undef %ConceptData;
1853: undef $GData;
1854: }
1855:
1856: #---- END HELPER FUNCTIONS ---------------------------------------------------
1857:
1858: sub BuildProblemStatisticsPage {
1859: my ($cacheDB, $students)=@_;
1860:
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);
1874:
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;
1884: # my @list=();
1885: # foreach (@$students) {
1886: # ($discriminantFactor, $list) = &ExtractStudentData(\%cache, $_,
1887: # \@list);
1888: # }
1889:
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",
1893: # 9,"S.D.",10,"Skew.",11,"D.F.1st",12,"D.F.2nd", 13, "Disc.");
1894: # &BuildStatisticsTable(\%cache, $discriminantFactor, \@list, \%Header,
1895: # $students);
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.'" />');
1909:
1910: return;
1911: }
1912:
1913: sub BuildWrongGraph {
1914: my ($courseID)=@_;
1915:
1916: my $graphData = &GetGraphData('WrongGraph', $courseID);
1917: $r->print('<IMG src="/cgi-bin/graph.gif?'.$graphData.'" />');
1918:
1919: return;
1920: }
1921:
1922: sub BuildAnalyzePage {
1923: my ($cacheDB, $students, $courseID)=@_;
1924:
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;
1929: }
1930:
1931: &ShowOpGraph(\%cache, $students, $courseID);
1932:
1933: untie(%cache);
1934:
1935: return;
1936: }
1937:
1938: sub BuildProblemAnalysisPage {
1939: my ($cacheDB)=@_;
1940:
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;
1945: }
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;
1958: }
1959:
1960: sub BuildStudentAssessmentPage {
1961: my ($cacheDB, $students, $courseID)=@_;
1962:
1963: my %cache;
1964:
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);
1972:
1973: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
1974: $r->print('<html><body>Unable to tie database.</body></html>');
1975: return;
1976: }
1977:
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: }
1998: }
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 .= '   ';
2007: $Ptr .= '<input type="submit" name="PreviousStudent" ';
2008: $Ptr .= 'value="Previous Student" />';
2009: $Ptr .= '   ';
2010: $Ptr .= '<input type="submit" name="NextStudent" ';
2011: $Ptr .= 'value="Next Student" />';
2012: $Ptr .= '   ';
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;
2022: }
2023:
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: }
2037:
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);
2045: }
2046:
2047: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
2048: $Ptr .= 'Could not tie database.';
2049: return $Ptr;
2050: }
2051: $r->print(&StudentReport(\%cache, $name));
2052: untie(%cache);
2053:
2054: return;
2055: }
2056:
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: }
2074:
2075: # ================================================================ Main Handler
2076:
2077: sub handler {
2078: $r=shift;
2079: &initial();
2080:
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'}) {
2100: my $requrl=$r->uri;
2101: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
2102: return HTTP_NOT_ACCEPTABLE;
2103: }
2104:
2105: $r->content_type('text/html');
2106: $r->send_http_header;
2107:
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;
2138: }
2139:
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);
2159: }
2160:
2161: $r->print("\n".'</body>'."\n".'</html>');
2162: $r->rflush();
2163:
2164: return OK;
2165: }
2166: 1;
2167: __END__
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