Annotation of loncom/interface/statistics/lonproblemstatistics.pm, revision 1.2
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
1.2 ! minaeibi 4: # $Id: lonproblemstatistics.pm,v 1.1 2002/07/24 14:52:32 stredwic Exp $
1.1 stredwic 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
1.2 ! minaeibi 34: # 5/12,5/14,5/15,5/19,5/26,7/16,7/25 Behrouz Minaei
1.1 stredwic 35: #
36: ###
37:
38: package Apache::lonproblemstatistics;
39:
40: use strict;
41: use Apache::lonnet();
42: use Apache::lonhtmlcommon;
43: use Apache::loncoursedata;
44: use GDBM_File;
45:
46: my %mapsort;
47:
48: sub BuildProblemStatisticsPage {
1.2 ! minaeibi 49: my ($cacheDB, $students, $courseID, $c, $r,%color)=@_;
1.1 stredwic 50: my %cache;
1.2 ! minaeibi 51: #my %DoDiff;
1.1 stredwic 52: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
53: return '<html><body>Unable to tie database.</body></html>';
54: }
55:
56: my $Ptr = '';
57: $Ptr .= '<table border="0"><tbody>';
58: $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
59: $Ptr .= '<td align="left">';
60: $Ptr .= &Apache::lonhtmlcommon::MapOptions(\%cache, 'ProblemStatistics');
61: $Ptr .= '</td></tr>'."\n";
62: $Ptr .= &AscendOrderOptions($cache{'Ascend'});
63: $Ptr .= &ProblemStatisticsButtons($cache{'DisplayFormat'});
1.2 ! minaeibi 64: $Ptr .= '</table>';
1.1 stredwic 65:
66: $Ptr .= &ProblemStatisticsLegend();
67:
68: untie(%cache);
69: foreach (@$students) {
70: my $courseData =
71: &Apache::loncoursedata::DownloadCourseInformation($_, $courseID);
72: last if ($c->aborted());
73: if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT,0640)) {
74: &Apache::loncoursedata::ProcessStudentData(\%cache,
75: $courseData, $_);
76: untie(%cache);
77: }
78: }
79: if($c->aborted()) { return $Ptr; }
80:
81: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
82: return '<html><body>Unable to tie database.</body></html>';
83: }
84: my $discriminantFactor;
85: my @list=();
1.2 ! minaeibi 86: my %Discuss=&Apache::loncoursedata::LoadDiscussion($courseID);
! 87: my $index=0;
1.1 stredwic 88: foreach (@$students) {
1.2 ! minaeibi 89: #&Apache::lonstatistics::Update_PrgWin(++$index,$r);
! 90: $discriminantFactor = &ExtractStudentData(\%cache, $_, \@list,\%Discuss);
1.1 stredwic 91: }
1.2 ! minaeibi 92: #&Apache::lonstatistics::Close_PrgWin($r);
! 93:
1.1 stredwic 94: return $Ptr;
95: my ($upper, $lower) = &Discriminant($discriminantFactor);
96: my %Header = (0,"Homework Sets Order",1,"#Stdnts",2,"Tries",3,"Mod",
97: 4,"Mean",5,"#YES",6,"#yes",7,"%Wrng",8,"DoDiff",
98: 9,"S.D.",10,"Skew.",11,"D.F.1st",12,"D.F.2nd", 13, "Disc.");
1.2 ! minaeibi 99:
! 100: my %GraphDat= &BuildStatisticsTable(\%cache, $discriminantFactor, \@list,
! 101: \%Header, $students, $r, \%color);
1.1 stredwic 102:
103: untie(%cache);
104:
105: return $Ptr;
106: }
107:
108: sub BuildDiffGraph {
1.2 ! minaeibi 109: my ($r)=@_;
1.1 stredwic 110:
1.2 ! minaeibi 111: my $graphData = &GetGraphData('DiffGraph', $r);
1.1 stredwic 112: return '<IMG src="/cgi-bin/graph.gif?'.$graphData.'" />';
113: }
114:
115: sub BuildWrongGraph {
1.2 ! minaeibi 116: my ($r)=@_;
1.1 stredwic 117:
1.2 ! minaeibi 118: my $graphData = &GetGraphData('WrongGraph', $r);
1.1 stredwic 119: return '<IMG src="/cgi-bin/graph.gif?'.$graphData.'" />';
120: }
121:
122: #---- Activity log -------------------------------------------------------
123:
124: sub LoadDoDiffFile {
125: my $file="/home/minaeibi/183d.txt";
126: open(FILEID, "<$file");
127: my $line=<FILEID>;
128: my %DoDiff=();
129: my @Act=split('&',$line);
130:
131: # $r->print('<br>'.$#Act);
132: for(my $n=0;$n<=$#Act;$n++){
133: my ($res,$Degree)=split('@',$Act[$n]);
134: $DoDiff{$res}=$Degree;
135: }
136:
137: return \%DoDiff;
138: }
139:
140: sub LoadClassFile {
141: my $file="/home/minaeibi/class.txt";
142: open(FILEID, "<$file");
143: my $line;
144: my %Grade=();
145: while ($line=<FILEID>) {
146: my ($id,$ex1,$ex2,$ex3,$ex4,$hw,$final,$grade)=split(' ',$line);
147: $Grade{$id}=$grade;
148: }
149: return \%Grade;
150: }
151:
152: #------- Classification
153: sub Classify {
154: my ($DiscFac, $students)=@_;
155: my ($fileGrade) = &LoadClassFile();
156: my $Count=0;
157: my @List=();
158: my @LS=();
159: my @LF=();
160: my @LM=();
161: my $cf=0;
162: my $cs=0;
163: my $cm=0;
164: foreach (keys(%$DiscFac)){
165: my @l=split(/\:/,$_);
166: if (!($students->{$l[1]})) {next;}
167: my $Grade=$fileGrade->{$students->{$l[1]}};
168: if( $Grade > 3 ) {
169: $cs++;
170: push(@LS,("$l[6],$l[5],$l[4],$l[7],$l[8],$l[9],Successful"));
171: } elsif ( $Grade > 2 ) {
172: $cm++;
173: push(@LM,("$l[6],$l[5],$l[4],$l[7],$l[8],$l[9],Average"));
174: } else {
175: $cf++;
176: push(@LF,("$l[6],$l[5],$l[4],$l[7],$l[8],$l[9],Failed"));
177: }
178: }
179: my $Str = '';
180: for(my $n=0;$n<$cs;$n++){$Str .= '<br>'.$LS[$n];}
181: for(my $n=0;$n<$cm;$n++){$Str .= '<br>'.$LM[$n];}
182: for(my $n=0;$n<$cf;$n++){$Str .= '<br>'.$LF[$n];}
183:
184: return $Str;
185: }
186:
187: sub ProcAct {
188: # return;
189: my ($Act,$Submit)=@_;
190: my @Act=split(/\@/,$Act);
191: @Act = sort(@Act);
192:
193: ##$r->print('<br>'.$#Act);
194: ##for(my $n=0;$n<=$#Act;$n++){
195: ## $r->print('<br>n='.$n.')'.$Act[$n]);
196: ## }
197:
198: # my $Beg=$Act[0];
199: my $Dif=$Submit-$Act[0];
200: $Dif = ($Dif>0) ? ($Dif/3600) : 0;
201:
202: # $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>');
203:
204:
205: #time spent for solving the problem
206: # $r->print('<br>Def'.($Act[$#Act-1]-$Act[0]));
207:
208: return $Dif;
209: }
210:
211: sub LoadActivityLog {
212: # my $CacheDB = "/home/minaeibi/act183.log.cache";
213: my $CacheDB = "/home/httpd/perl/tmp/act183.log.cache";
214:
215: my %Activity;
216: if (-e "$CacheDB") {
217: if (tie(%Activity,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) {
218: return;
219: }
220: else {
221: # $r->print("Unable to tie log Cache hash to db file");
222: }
223: }
224: else {
225: if (tie(%Activity,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) {
226: foreach (keys %Activity) {delete $Activity{$_};}
227: &Build_log(\%Activity);
228: }
229: else {
230: # $r->print("Unable to tie log Build hash to db file");
231: }
232: }
233: return \%Activity;
234: }
235:
236: sub Build_log {
237: my ($Activity)=@_;
238: my $file="/home/minaeibi/act183.log";
239: open(FILEID, "<$file");
240: my $line;
241: my $count=0;
242: while ($line=<FILEID>) {
243: my ($time,$machine,$what)=split(':',$line);
244: $what=&Apache::lonnet::unescape($what);
245: my @accesses=split('&',$what);
246:
247: foreach my $access (@accesses) {
248:
249: $count++;
250:
251: my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
252: if (!$resource) { next; }
253: my $res=&Apache::lonnet::unescape($resource);
254: if (($res =~ /\.problem/)) {
255: $Activity->{$who.':'.$res}.=$date.'@';
256: #$r->print('<br>'.$time.':'.$who.'---'.$res);
257: &Update_PrgInit($count);
258:
259: }
260: }
261: }
262:
263: # my $c=1;
264: # foreach (sort keys %Activity) {
265: # $r->print('<br>'.$c.')'.$_.' ... '.$Activity{$_});
266: # $c++;
267: # }
268:
269: }
270:
271: sub Activity {
272: my $file="/home/minaeibi/activity.log";
273: my $userid='adamsde1';
1.2 ! minaeibi 274: # $r->print("<br>Using $file");
! 275: # $r->rflush();
1.1 stredwic 276: open(FILEID, "<$file");
277: my $line;
278: my @allaccess;
279: my $Count=0;
280: while ($line=<FILEID>) {
281: my ($time,$machine,$what)=split(':',$line);
282: $what=&Apache::lonnet::unescape($what);
283: my @accesses=split('&',$what);
284: foreach my $access (@accesses) {
285: my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
286: #if ($who ne $userid) { next; }
287: if (!$resource) { next; }
288: my $res=&Apache::lonnet::unescape($resource);
289: if (($res =~ /\.(sequence|problem|htm|html|page)/)) {
290: $Count++;
1.2 ! minaeibi 291: ###888 $r->print("<br>$Count) ".localtime($date).": $who --> $res");
1.1 stredwic 292: # if ($post) {
293: # $Count++;
294: # $r->print("<br><b>$Count) Sent data ".join(':',
295: # &Apache::lonnet::unescape(@posts)).'</b>');
296: # }
1.2 ! minaeibi 297: ###888 $r->rflush();
1.1 stredwic 298: }
299: #push (@allaccess,unescape($access));
300: #print $machine;
301: }
302: }
303: # @allaccess=sort(@allaccess);
304: # $Count=0;
305: # foreach my $access (@allaccess) {
306: # my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
307: # $Count++;
308: # $r->print("<br>$Count) $date: $who --> $resource");
309: # $r->rflush();
310: # if ($post) {
311: # $r->print("<br><b>Sent data ".join(':',unescape(@posts)).'</b>');
312: # }
313: # }
314: }
315:
316: #---- END Activity log ---------------------------------------------------
317:
318: #---- Problem Statistics Web Page ---------------------------------------
319:
320: #------- Processing upperlist and lowerlist according to each problem
321: sub ProcessDiscriminant {
322: my ($List) = @_;
323: my @sortedList = sort (@$List);
324: my $Count = scalar @sortedList;
325: my $Problem;
326: my @Dis;
327: my $Slvd=0;
328: my $tmp;
329: my $Sum1=0;
330: my $Sum2=0;
331: my $nIndex=0;
332: my $nStudent=0;
333: my %Proc=undef;
334: while ($nIndex<$Count) {
335: ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]);
336: @Dis=split(/\+/,$tmp);
337: my $Temp = $Problem;
338: do {
339: $nIndex++;
340: $nStudent++;
341: $Sum1 += $Dis[0];
342: $Sum2 += $Dis[1];
343: ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]);
344: @Dis=split(/\+/,$tmp);
345: } while ( $Problem eq $Temp && $nIndex < $Count );
346: # $Proc{$Temp}=($Sum1/$nStudent).':'.$nStudent;
347: $Proc{$Temp}=($Sum1/$nStudent).':'.($Sum2/$nStudent);
348: # $r->print("$nIndex) $Temp --> ($nStudent) $Proc{$Temp} <br>");
349: $Sum1=0;
350: $Sum2=0;
351: $nStudent=0;
352: }
353:
354: return %Proc;
355: }
356:
357: #------- Creating Discimination factor
358: sub Discriminant {
359: my ($discriminantFactor)=@_;
360: my @discriminantKeys=keys(%$discriminantFactor);
361: my $Count = scalar @discriminantKeys;
362:
363: my $UpCnt = int(0.27*$Count);
364: my $low=0;
365: my $up=$Count-$UpCnt;
366: my @UpList=();
367: my @LowList=();
368:
369: $Count=0;
370: foreach my $key (sort(@discriminantKeys)) {
371: $Count++;
372: if($low < $UpCnt || $Count > $up) {
373: $low++;
374: my $str=$discriminantFactor->{$key};
375: foreach(split(/\:/,$str)){
376: if($_) {
377: if($low<$UpCnt) { push(@LowList,$_); }
378: else { push(@UpList,$_); }
379: }
380: }
381: }
382: }
383: my %DisUp = &ProcessDiscriminant(\@UpList);
384: my %DisLow = &ProcessDiscriminant(\@LowList);
385:
386: return (\%DisUp, \%DisLow);
387: }
388:
389:
390: sub NumericSort {
391: $a <=> $b;
392: }
393:
394:
395: sub CreateProblemStatisticsTableHeading {
1.2 ! minaeibi 396: my ($displayFormat,$sequenceSource,$sequenceTitle,$headings,$r)=@_;
1.1 stredwic 397: if($displayFormat eq 'Display CSV Format') {
398: $r->print('<br>"'.$sequenceTitle.'","');
399: $r->print($sequenceSource.'"');
400: return;
401: }
402:
403: $r->print('<br><a href="'.$sequenceSource.
404: '" target="_blank">'.$sequenceTitle.'</a>');
405:
406: my $Result = "\n".'<table border=2><tr><th>P#</th>'."\n";
407: for(my $nIndex=0; $nIndex < (scalar (keys %$headings)); $nIndex++) {
408: $Result .= '<th>'.'<input type="submit" name="';
409: $Result .= 'ProblemStatisticsHeading" value="';
410: $Result .= $headings->{$nIndex}.'" />'.'</th>'."\n";
411: }
412: $Result .= "\n".'</tr>'."\n";
413: $r->print($Result);
414: $r->rflush();
415: }
416:
417: sub CloseTable {
1.2 ! minaeibi 418: my ($cache,$r)=@_;
1.1 stredwic 419: if($cache->{'DisplayFormat'} eq 'Display CSV Format') {
420: return;
421: }
422: $r->print("\n".'</table>'."\n");
423: $r->rflush();
424: }
425:
426:
427:
428: # ------ Dump the Student's DB file and handling the data for statistics table
429: sub ExtractStudentData {
1.2 ! minaeibi 430: my ($cache,$name,$list,%Discuss)=@_;
1.1 stredwic 431: my %discriminantFactor;
432:
433: my $totalTries = 0;
434: my $totalAwarded = 0;
435: my $tempProblemOrder=0;
436: my $spent=0;
437: my $spent_yes=0;
438: my $TotDiscuss=0;
439: my $TotalOpend = 0;
440: my $ProbSolved = 0;
441: my $ProbTot = 0;
442: my $TotFirst = 0;
443: my $TimeTot = 0;
444: my $Discussed=0;
445:
446: foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
447: if($cache->{'ProblemStatisticsMap'} ne 'All Maps' &&
448: $cache->{'ProblemStatisticsMap'} ne $cache->{$sequence.':title'}) {
449: next;
450: }
451:
452: my $Dis = '';
453: foreach my $problemID (split(':', $cache->{$sequence.':problems'})) {
454: my $problem = $cache->{$problemID.':problem'};
455: my $LatestVersion = $cache->{$name.':version:'.$problem};
456:
457: # Output dashes for all the parts of this problem if there
458: # is no version information about the current problem.
459: #if(!$LatestVersion) {
460: # foreach my $part (split(/\:/,$cache->{$sequence.':'.
461: # $problemID.
462: # ':parts'})) {
463: # $codes .= "-,";
464: # $attempts .= "0,";
465: # }
466: # next;
467: #}
468:
469: my %partData=undef;
470: # Initialize part data, display skips correctly
471: # Skip refers to when a student made no submissions on that
472: # part/problem.
473: foreach my $part (split(/\:/,$cache->{$sequence.':'.
474: $problemID.
475: ':parts'})) {
476: $partData{$part.':tries'}=0;
477: $partData{$part.':code'}='-';
478: }
479:
480: # Looping through all the versions of each part, starting with the
481: # oldest version. Basically, it gets the most recent
482: # set of grade data for each part.
483: for(my $Version=1; $Version<=$LatestVersion; $Version++) {
484: foreach my $part (split(/\:/,$cache->{$sequence.':'.
485: $problemID.
486: ':parts'})) {
487:
488: if(!defined($cache->{$name.":$Version:$problem".
489: ":resource.$part.solved"})) {
490: # No grade for this submission, so skip
491: next;
492: }
493:
494: my $tries=0;
495: my $time=0;
496: my $awarded=0;
497: $Discussed=0;
498: my $code='U';
499:
500: $awarded = $cache->{$name.
501: "$Version:$problem:resource.".
502: "$part.awarded"};
503: $partData{$part.':awarded'} = ($awarded) ? $awarded : 0;
504: $totalAwarded += $awarded;
505:
506: $tries = $cache->{$name.":$Version:$problem".
507: ":resource.$part.tries"};
508: $partData{$part.':tries'} = ($tries) ? $tries : 0;
509: $partData{$part.':wrong'} = $partData{$part.':tries'};
510: $totalTries += $tries;
511:
512: my $val = $cache->{$name.":$Version:$problem".
513: ":resource.$part.solved"};
514: if ($val eq 'correct_by_student') {$code = 'C';}
515: elsif ($val eq 'correct_by_override') {$code = 'O';}
516: elsif ($val eq 'incorrect_attempted') {$code = 'I';}
517: elsif ($val eq 'incorrect_by_override'){$code = 'I';}
518: elsif ($val eq 'excused') {$code = 'x';}
519: $partData{$part.':code'}=$code;
520:
521: if($partData{$part.':wrong'} ne 0 &&
522: ($code eq 'C' || $code eq 'O')) {
523: $partData{$part.':wrong'}--;
524: }
525: }
526: }
527:
528: # Loop through all the parts for the current problem in the
529: # correct order and prepare the output
530: foreach (split(/\:/,$cache->{$sequence.':'.$problemID.
531: ':parts'})) {
532: my $Yes = 0;
533: if($partData{$_.':code'} eq 'C' ||
534: $partData{$_.':code'} eq 'O') {
535: $Yes=1;
536: }
537: my $ptr = $tempProblemOrder.'&'.$problemID;
538:
539: if($_ > 1) {
540: $ptr .= "*(part $_)";
541: $Dis .= '&';
542: }
543:
544: my ($pr_no,$dod)=split('&',$ptr);
545: # my $DoDiff=$DoDiff->{$dod};
546: # $r->print('<br>'.$name.'---'.$ptr.'==='.$DoDiff);
547:
548: my $Fac = ($partData{$_.':Tries'}) ?
549: ($partData{$_.':awarded'}/$partData{$_.':tries'}) : 0;
550: my $DisF;
551: if($Fac > 0 && $Fac < 1) {
552: $DisF = sprintf( "%.4f", $Fac );
553: } else {
554: $DisF = $Fac;
555: }
556:
557: if ($Discuss{"$name:$problem"}) {
558: $TotDiscuss++;
559: $Discussed=1;
560: }
561: my $time = $cache->{"$name:$LatestVersion:$problem:timestamp"};
562: $Dis .= $tempProblemOrder.'='.$DisF.'+'.$Yes;
563: $ptr .= '&'.$partData{$_.'.Tries'}.
564: '&'.$partData{$_.'.Wrongs'}.
565: '&'.$partData{$_.'.Code'};
566: push (@$list, $ptr."&$Discussed");
567:
568: #### if ($DoDiff>0.85) {
569:
570: $TimeTot += $time;
571:
572: if ($Yes==1 && $partData{$_.'.Tries'}==1) {
573: $TotFirst++;
574: }
575: # my $Acts= $Activity->{$name.':'.$problem};
576: # if ($Acts) {
577: # my $Pt=&ProcAct( $Acts, $time );
578: #my ($spe,$beg) = split(/\+/,$Pt);
579: # my $spe= $Pt;
580: # if ($Yes==1) {$spent_yes += $spe;}
581: # $spent += $spe;
582: #$Beg += $beg;
583: # $r->print('<br>'.$name.'---'.$problem.'---'.$spe);
584: # }
585: $TotalOpend++;
586: $ProbTot++;
587:
588: $tempProblemOrder++;
589: }
590: }
591: my $pstr;
592: if($totalTries) {
593: my $DisFac = ($totalAwarded/$totalTries);
594: my $DisFactor = sprintf( "%.4f", $DisFac );
595: my $TS = sprintf( "%.2f", $spent );
596: my $TS_yes = sprintf( "%.2f", $spent_yes );
597: # $DiscFac{$DisFactor}=$Dis;
598: $pstr=$DisFactor.':'.$name.':'.$ProbTot.':'.$TotalOpend.':'.
599: $totalTries.':'.$ProbSolved.':'.$TotFirst.':'.
600: $TS_yes.':'.$TS.':'.$TotDiscuss;
601: $discriminantFactor{$pstr}=$Dis;
602: }
603: }
604:
605: return (\%discriminantFactor);
606: }
607:
608:
609: =pod
610: sub MySort {
611: if ( $Pos > 0 ) {
612: if ($ENV{'form.order'} eq 'Descending') {$b <=> $a;}
613: else { $a <=> $b; }
614: }
615: else {
616: if ($ENV{'form.order'} eq 'Descending') {$b cmp $a;}
617: else { $a cmp $b; }
618: }
619: }
620: =cut
621:
622: sub BuildStatisticsTable {
1.2 ! minaeibi 623: my ($cache,$discriminantFactor,$list,$headings,$students,$r,%color)=@_;
1.1 stredwic 624:
625: #6666666
626: # my $file="/home/httpd/perl/tmp/183d.txt";
627: # open(OUT, ">$file");
628: #6666666
1.2 ! minaeibi 629: ## &Apache::lonstatistics::Create_PrgWin($r);
1.1 stredwic 630: ##777777
631: ## my (%Activity) = &LoadActivityLog();
632: ## $r->print('<script>popwin.document.popremain.remaining.value="'.
633: ## 'Loading Discussion...";</script>');
634: ## my ($doDiffFile) = &LoadDoDiffFile();
635:
636: my $p_count = 0;
637: my $nIndex = 0;
638: my $dummy;
639: my $p_val;
640: my $ResId;
1.2 ! minaeibi 641: my %GraphDat;
1.1 stredwic 642: my $NoElements = scalar @$list;
643:
644: foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
645: if($cache->{'ProblemStatisticsMap'} ne 'All Maps' &&
646: $cache->{'ProblemStatisticsMap'} ne $cache->{$sequence.':title'}) {
647: next;
648: }
649:
650: &CreateProblemStatisticsTableHeading($cache->{'DisplayFormat'},
651: $cache->{$sequence.':source'},
652: $cache->{$sequence.':title'},
1.2 ! minaeibi 653: $headings,$r);
1.1 stredwic 654:
655: ##777777
656: ## $Str .= &Classify($discriminantFactor, $students);
657:
658:
659: my ($Hid,$pr)=split(/\:/,$mapsort{$_});
660: my @lpr=split(/\&/,$pr);
661: for (my $i=1; $i<=$#lpr; $i++) {
662: my %storestats=();
663: my ($PrOrd,$Prob,$Tries,$Wrongs,$Code,$Disc)=split(/\&/,$list->[$nIndex]);
664: my $Temp = $Prob;
665: my $MxTries = 0;
666: my $TotalTries = 0;
667: my $YES = 0;
668: my $Incorrect = 0;
669: my $Override = 0;
670: my $StdNo = 0;
671: my $DiscNo=0;
672: my @StdLst;
673: while ( $PrOrd == $lpr[$i] )
674: {
675: $nIndex++;
676: $StdNo++;
677: $StdLst[ $StdNo ] = $Tries;
678: $TotalTries += $Tries;
679: if ( $MxTries < $Tries ) { $MxTries = $Tries; }
680: if ( $Code eq 'C' ){ $YES++; }
681: elsif( $Code eq 'I' ) { $Incorrect++; }
682: elsif( $Code eq 'O' ) { $Override++; }
683: elsif( $Code eq 'U' ) { $StdNo--; }
684: ($PrOrd,$Prob,$Tries,$Wrongs,$Code,$Disc)=split(/\&/,$list->[$nIndex]);
685: }
686:
687: $p_count++;
688: my $Dummy;
689: ($ResId,$Dummy)=split(/\*/,$Temp);
690:
1.2 ! minaeibi 691: $Temp = '<a href="'.$cache->{'src_'.$ResId}.
! 692: '" target="_blank">'.$cache->{'title_'.$ResId}.$Dummy.'</a>';
1.1 stredwic 693:
1.2 ! minaeibi 694: my $res = &Apache::lonnet::declutter($cache->{'src_'.$ResId});
1.1 stredwic 695: my $urlres=$res;
696:
697: $ResId=~/(\d+)\.(\d+)/;
1.2 ! minaeibi 698: my $Map = &Apache::lonnet::declutter( $cache->{'map_id_'.$1} );
1.1 stredwic 699: $urlres=$Map;
700:
1.2 ! minaeibi 701: $res = '<a href="'.$cache->{'src_'.$ResId}.'">'.$res.'</a>';
1.1 stredwic 702: #$Map = '<a href="'.$Map.'">'.$res.'</a>';
703:
704: #------------------------ Compute the Average of Tries about one problem
705: my $Average = ($StdNo) ? $TotalTries/$StdNo : 0;
706:
707: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___timestamp'}=time;
708: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___stdno'}=$StdNo;
709: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___avetries'}=$Average;
710:
711: #-------------------------------- Compute percentage of Wrong tries
712: my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0;
713:
714: #-------------------------------- Compute Standard Deviation
715: my $StdDev = 0;
716: if ( $StdNo > 1 ) {
717: for ( my $n = 0; $n < $StdNo; $n++ ) {
718: my $Dif = $StdLst[ $n ]-$Average;
719: $StdDev += $Dif*$Dif;
720: }
721: $StdDev /= ( $StdNo - 1 );
722: $StdDev = sqrt( $StdDev );
723: }
724:
725: #-------------------------------- Compute Degree of Difficulty
726: my $DoDiff = 0;
727: if( $TotalTries > 0 ) {
728: $DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries );
729: # $DoDiff = ($TotalTries)/($YES + $Override+ 0.1);
730: }
731:
732: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff;
733:
734: #-------------------------------- Compute the Skewness
735: my $Skewness = 0;
736: my $Sum = 0;
737: if ( $StdNo > 0 && $StdDev > 0 ) {
738: for ( my $n = 0; $n < $StdNo; $n++ ) {
739: my $Dif = $StdLst[ $n ]-$Average;
740: $Skewness += $Dif*$Dif*$Dif;
741: }
742: $Skewness /= $StdNo;
743: $Skewness /= $StdDev*$StdDev*$StdDev;
744: }
745:
746: #--------------------- Compute the Discrimination Factors
747: my ($Up1,$Up2)=split(/\:/,':');#jason$DisUp->{$lpr[$i]});
748: my ($Lw1,$Lw2)=split(/\:/,':');#jason$DisLow->{$lpr[$i]});
749: my $Dis1 = $Up1 - $Lw1;
750: my $Dis2 = $Up2 - $Lw2;
751: my $_D1 = sprintf("%.2f", $Dis1);
752: my $_D2 = sprintf("%.2f", $Dis2);
753:
754: #----------------- Some restition in presenting the float numbers
755: my $Avg = sprintf( "%.2f", $Average );
756: my $Wrng = sprintf( "%.1f", $Wrong );
757: my $SD = sprintf( "%.1f", $StdDev );
758: my $DoD = sprintf( "%.2f", $DoDiff );
759: my $Sk = sprintf( "%.1f", $Skewness );
760: my $join = $lpr[$i].'&'.$Temp.'&'.$StdNo.'&'.
761: $TotalTries.'&'.$MxTries.'&'.$Avg.'&'.
762: $YES.'&'.$Override.'&'.$Wrng.'&'.$DoD.'&'.
763: $SD.'&'.$Sk.'&'.$_D1.'&'.$_D2.'&'.
764: $DiscNo.'&'.$Prob;
1.2 ! minaeibi 765: ##8888 $CachData{($p_count-1)}=$join;
1.1 stredwic 766:
767: #6666666
768: # $r->print('<br>'.$out.'&'.$DoD);
769: # print (OUT $out.'@'.$DoD.'&');
770: #6666666
771:
772: $urlres=~/^(\w+)\/(\w+)/;
773: if ($StdNo) {
774: &Apache::lonnet::put('resevaldata',\%storestats,$1,$2);
775: }
776: #-------------------------------- Row of statistical table
1.2 ! minaeibi 777: &TableRow($cache,$join,$i,($p_count-1),$r,\%color,\%GraphDat);
1.1 stredwic 778: }
1.2 ! minaeibi 779: &CloseTable($cache,$r);
1.1 stredwic 780: }
781: &Close_PrgWin();
782: #666666
783: # close( OUT );
784: #666666
785: }
786:
787: =pod
788: sub Cache_Statistics {
1.2 ! minaeibi 789: my ($cache,$color)=@_;
1.1 stredwic 790: my @list = ();
791: my $Useful;
792: my $UnUseful;
793: # $r->print('<input type="hidden" name="show" value="excel" />'."\n");
794: my %myHeader = reverse( %Header );
795: $Pos = $myHeader{$ENV{'form.sort'}};
796: if ($Pos > 0) {$Pos++;}
797: my $p_count = 0;
798: foreach my $key( keys %CachData) {
799: my @Temp=split(/\&/,$CachData{$key});
800: if ( $Pos == 0 ) {
801: ($UnUseful,$Useful)=split(/\>/,$Temp[$Pos]);
802: }
803: else {
804: $Useful = $Temp[$Pos];
805: }
806: $list[$p_count]=$Useful.'@'.$CachData{$key};
807: $p_count++;
808: }
809:
810: @list = sort MySort (@list);
811:
812: my $nIndex=0;
813:
814: if ( $Pos == 0 ) {
815: foreach (sort keys %mapsort) {
816: my ($Hid,$pr)=split(/\:/,$mapsort{$_});
817: &CreateProblemStatisticsTableHeading($cache,1,$Hid);
818: my @lpr=split(/\&/,$pr);
819: for (my $i=1; $i<=$#lpr; $i++) {
820: my($Pre, $Post) = split(/\@/,$list[$nIndex]);
821: #$r->print('<br>'.$Pre.'---'.$Post);
1.2 ! minaeibi 822: &TableRow($cache,$Post,$i,$nIndex,\%color,\%GraphDat);
1.1 stredwic 823: $nIndex++;
824: }
825: &CloseTable($cache);
826: }
827: }
828: else {
829: &CreateProblemStatisticsTableHeading($cache,0);
830: for ( my $nIndex = 0; $nIndex < $p_count; $nIndex++ ) {
831: my($Pre, $Post) = split(/\@/,$list[$nIndex]);
1.2 ! minaeibi 832: &TableRow($cache,$Post,$nIndex,$nIndex,\%color,\%GraphDat);
1.1 stredwic 833: }
834: &CloseTable($cache);
835: }
836: }
837: =cut
838:
839: sub TableRow {
1.2 ! minaeibi 840: my ($cache,$Str,$Idx,$RealIdx,$r,$color,$GraphDat)=@_;
1.1 stredwic 841: my($PrOrd,$Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override,
842: $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$DiscNo,$Prob)=split(/\&/,$Str);
843: if ($ENV{'form.showcsv'}) {
844: my ($ResId,$Dummy)=split(/\*/,$Prob);
845: my $Ptr = "\n".'<br>'.
846: "\n".'"'.($RealIdx+1).'",'.
1.2 ! minaeibi 847: "\n".'"'.$cache->{'title_'.$ResId}.$Dummy.'",'.
! 848: "\n".'"'.$cache->{'src_'.$ResId}.'",'.
1.1 stredwic 849: "\n".'"'.$StdNo.'",'.
850: "\n".'"'.$TotalTries.'",'.
851: "\n".'"'.$MxTries.'",'.
852: "\n".'"'.$Avg.'",'.
853: "\n".'"'.$YES.'",'.
854: "\n".'"'.$Override.'",'.
855: "\n".'"'.$Wrng.'",'.
856: "\n".'"'.$DoD.'",'.
857: "\n".'"'.$SD.'",'.
858: "\n".'"'.$Sk.'",'.
859: "\n".'"'.$_D1.'",'.
860: "\n".'"'.$_D2.'"'.
861: "\n".'"'.$DiscNo.'"';
862:
863: $r->print("\n".$Ptr);
864: }
865: else{
866: my $Ptr = "\n".'<tr>'.
867: "\n".'<td>'.($RealIdx+1).'</td>'.
868: # "\n".'<td>'.$PrOrd.$Temp.'</td>'.
869: "\n".'<td>'.$Temp.'</td>'.
1.2 ! minaeibi 870: "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$StdNo.'</td>'.
! 871: "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$TotalTries.'</td>'.
! 872: "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$MxTries.'</td>'.
! 873: "\n".'<td bgcolor='.$color->{"gb"}.'>'.$Avg.'</td>'.
! 874: "\n".'<td bgcolor='.$color->{"gb"}.'> '.$YES.'</td>'.
! 875: "\n".'<td bgcolor='.$color->{"gb"}.'> '.$Override.'</td>'.
! 876: "\n".'<td bgcolor='.$color->{"red"}.'> '.$Wrng.'</td>'.
! 877: "\n".'<td bgcolor='.$color->{"red"}.'> '.$DoD.'</td>'.
! 878: "\n".'<td bgcolor='.$color->{"green"}.'> '.$SD.'</td>'.
! 879: "\n".'<td bgcolor='.$color->{"green"}.'> '.$Sk.'</td>'.
! 880: "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D1.'</td>'.
! 881: "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D2.'</td>'.
! 882: "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$DiscNo.'</td>';
1.1 stredwic 883: $r->print("\n".$Ptr.'</tr>' );
884: }
1.2 ! minaeibi 885: $GraphDat->{$RealIdx}=$DoD.':'.$Wrng;
1.1 stredwic 886: }
887:
888: sub StatusOptions {
889: my ($cache)=@_;
890:
891: my $Status = $cache->{'Status'};
892: my $OpSel1 = '';
893: my $OpSel2 = '';
894: my $OpSel3 = '';
895:
896: if($Status eq 'Any') { $OpSel3 = ' selected'; }
897: elsif($Status eq 'Expired' ) { $OpSel2 = ' selected'; }
898: else { $OpSel1 = ' selected'; }
899:
900: my $Ptr = '';
901: $Ptr .= '<tr><td align="right"><b>Student Status:</b></td>'."\n";
902: $Ptr .= '<td align="left"><select name="Status">';
903: $Ptr .= '<option'.$OpSel1.'>Active</option>'."\n";
904: $Ptr .= '<option'.$OpSel2.'>Expired</option>'."\n";
905: $Ptr .= '<option'.$OpSel3.'>Any</option>'."\n";
906: $Ptr .= '</select></td></tr>'."\n";
907:
908: return $Ptr;
909: }
910:
911: sub AscendOrderOptions {
912: my ($order)=@_;
913:
914: my $OpSel1 = '';
915: my $OpSel2 = '';
916:
917: if($order eq 'Ascending') {
918: $OpSel1 = ' selected';
919: } else {
920: $OpSel2 = ' selected';
921: }
922:
923: my $Ptr = '';
924: $Ptr .= '<tr><td align="right"><b>Sorting Type:</b></td>'."\n";
925: $Ptr .= '<td align="left"><select name="Ascend">'."\n";
926: $Ptr .= '<option'.$OpSel1.'>Ascending</option>'."\n".
927: '<option'.$OpSel2.'>Descending</option>'."\n";
928: $Ptr .= '</select></td></tr>'."\n";
929:
930: return $Ptr;
931: }
932:
933: sub ProblemStatisticsButtons {
934: my ($displayFormat)=@_;
935:
936: my $Ptr = '<tr><td></td><td align="left">';
937: $Ptr .= '<input type=submit name="ProblemStatisticsRecalculate" ';
938: $Ptr .= 'value="Recalculate Statistics"/>'."\n";
939: $Ptr .= ' ';
940: $Ptr .= '<input type="submit" name="DoDiffGraph" ';
941: $Ptr .= 'value="DoDiff Graph" />'."\n";
942: $Ptr .= ' ';
943: $Ptr .= '<input type="submit" name="PercentWrongGraph" ';
944: $Ptr .= 'value="%Wrong Graph" />'."\n";
945: $Ptr .= ' ';
946: $Ptr .= '<input type="submit" name="DisplayCSVFormat" ';
947: if($displayFormat eq 'Display CSV Format') {
948: $Ptr .= 'value="Display CSV Format" />'."\n";
949: } else {
950: $Ptr .= 'value="Display Table Format" />'."\n";
951: }
952: $Ptr .= '</td></tr>';
953:
954: return $Ptr;
955: }
956:
957: sub ProblemStatisticsLegend {
958: my $Ptr = '';
959: $Ptr = '<table border="0">';
960: $Ptr .= '<tr><td>';
961: $Ptr .= '<b>#Stdnts</b>:</td>';
962: $Ptr .= '<td>Total Number of Students opened the problem.';
963: $Ptr .= '</td></tr><tr><td>';
964: $Ptr .= '<b>Tries</b>:</td>';
965: $Ptr .= '<td>Total Number of Tries for solving the problem.';
966: $Ptr .= '</td></tr><tr><td>';
967: $Ptr .= '<b>Mod</b>:</td>';
968: $Ptr .= '<td>Maximunm Number of Tries for solving the problem.';
969: $Ptr .= '</td></tr><tr><td>';
970: $Ptr .= '<b>Mean</b>:</td>';
971: $Ptr .= '<td>Average Number of the tries. [ Tries / #Stdnts ]';
972: $Ptr .= '</td></tr><tr><td>';
973: $Ptr .= '<b>#YES</b>:</td>';
974: $Ptr .= '<td>Number of students solved the problem correctly.';
975: $Ptr .= '</td></tr><tr><td>';
976: $Ptr .= '<b>#yes</b>:</td>';
977: $Ptr .= '<td>Number of students solved the problem by override.';
978: $Ptr .= '</td></tr><tr><td>';
979: $Ptr .= '<b>%Wrng</b>:</td>';
980: $Ptr .= '<td>Percentage of students tried to solve the problem ';
981: $Ptr .= 'but still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]';
982: $Ptr .= '</td></tr><tr><td>';
983: $Ptr .= '<b>DoDiff</b>:</td>';
984: $Ptr .= '<td>Degree of Difficulty of the problem. ';
985: $Ptr .= '[ 1 - ((#YES+#yes) / Tries) ]';
986: $Ptr .= '</td></tr><tr><td>';
987: $Ptr .= '<b>S.D.</b>:</td>';
988: $Ptr .= '<td>Standard Deviation of the tries. ';
989: $Ptr .= '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) ';
990: $Ptr .= 'where Xi denotes every student\'s tries ]';
991: $Ptr .= '</td></tr><tr><td>';
992: $Ptr .= '<b>Skew.</b>:</td>';
993: $Ptr .= '<td>Skewness of the students tries.';
994: $Ptr .= '[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]';
995: $Ptr .= '</td></tr><tr><td>';
996: $Ptr .= '<b>Dis.F.</b>:</td>';
997: $Ptr .= '<td>Discrimination Factor: A Standard for evaluating the ';
998: $Ptr .= 'problem according to a Criterion<br>';
999: $Ptr .= '<b>[Applied Criterion in %27 Upper Students - ';
1000: $Ptr .= 'Applied the same Criterion in %27 Lower Students]</b><br>';
1001: $Ptr .= '<b>1st Criterion</b> for Sorting the Students: ';
1002: $Ptr .= '<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>';
1003: $Ptr .= '<b>2nd Criterion</b> for Sorting the Students: ';
1004: $Ptr .= '<b>Total number of Correct Answers / Total Number of Tries</b>';
1005: $Ptr .= '</td></tr>';
1006: $Ptr .= '<tr><td><b>Disc.</b></td>';
1007: $Ptr .= '<td>Number of Students had at least one discussion.';
1008: $Ptr .= '</td></tr></table>';
1009:
1010: return $Ptr;
1011: }
1012:
1013: #---- END Problem Statistics Web Page ----------------------------------------
1014:
1015: #---- Problem Statistics Graph Web Page --------------------------------------
1016:
1017: # ------------------------------------------- Prepare data for Graphical chart
1018:
1019: sub GetGraphData {
1.2 ! minaeibi 1020: my ($ylab,$r,%GraphDat)=@_;
1.1 stredwic 1021: my $Col;
1022: my $data='';
1023: my $count = 0;
1024: my $Max = 0;
1025: my $cid=$ENV{'request.course.id'};
1026: my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
1027: "_$ENV{'user.domain'}_$cid\_graph.db";
1028: foreach (keys %GraphDat) {delete $GraphDat{$_};}
1029: if (-e "$GraphDB") {
1030: if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) {
1031: if ( $ylab eq 'DoDiff Graph' ) {
1032: $ylab = 'Degree-of-Difficulty';
1033: $Col = 0;
1034: }
1035: else {
1036: $ylab = 'Wrong-Percentage';
1037: $Col = 1;
1038: }
1039: foreach (sort NumericSort keys %GraphDat) {
1040: my @Temp=split(/\:/,$GraphDat{$_});
1041: my $inf = $Temp[$Col];
1042: if ( $Max < $inf ) {$Max = $inf;}
1043: $data .= $inf.',';
1044: $count++;
1045: }
1046: if ( $Max > 1 ) {
1047: $Max += (10 - $Max % 10);
1048: $Max = int($Max);
1049: }
1050: else { $Max = 1; }
1051: untie(%GraphDat);
1052: my $Course = $ENV{'course.'.$cid.'.description'};
1053: $Course =~ s/\ /"_"/eg;
1054: my $GData=$Course.'&'.'Problems'.'&'.$ylab.'&'.$Max.'&'.$count.'&'.$data;
1055: }
1056: else {
1057: $r->print("Unable to tie hash to db file");
1058: }
1059: }
1060: }
1061: 1;
1062: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonproblemstatistics.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface / statistics