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