Annotation of loncom/interface/statistics/lonproblemstatistics.pm, revision 1.25
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
1.25 ! stredwic 4: # $Id: lonproblemstatistics.pm,v 1.24 2002/08/14 13:13:37 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.12 minaeibi 34: # 5/12,5/14,5/15,5/19,5/26,7/16,7/25,7/29,8/5 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.19 stredwic 46: my $jr;
1.1 stredwic 47:
48: sub BuildProblemStatisticsPage {
1.5 minaeibi 49: my ($cacheDB, $students, $courseID, $c, $r)=@_;
1.1 stredwic 50: my %cache;
1.16 minaeibi 51:
1.19 stredwic 52: $jr = $r;
53:
1.18 albertel 54: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
1.21 stredwic 55: $r->print('Unable to tie database.');
56: return;
1.1 stredwic 57: }
58:
1.25 ! stredwic 59: # Remove students who don't have the proper section.
! 60: my @sectionsSelected = split(':',$cache{'sectionsSelected'});
! 61: for(my $studentIndex=((scalar @$students)-1); $studentIndex>=0;
! 62: $studentIndex--) {
! 63: my $value = $cache{$students->[$studentIndex].':section'};
! 64: my $found = 0;
! 65: foreach (@sectionsSelected) {
! 66: if($_ eq 'none') {
! 67: if($value eq '' || !defined($value) || $value eq ' ') {
! 68: $found = 1;
! 69: last;
! 70: }
! 71: } else {
! 72: if($value eq $_) {
! 73: $found = 1;
! 74: last;
! 75: }
! 76: }
! 77: }
! 78: if($found == 0) {
! 79: splice(@$students, $studentIndex, 1);
! 80: }
! 81: }
! 82:
1.1 stredwic 83: my $Ptr = '';
84: $Ptr .= '<table border="0"><tbody>';
85: $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
86: $Ptr .= '<td align="left">';
1.9 stredwic 87: $Ptr .= &Apache::lonhtmlcommon::MapOptions(\%cache, 'ProblemStatistics',
88: 'Statistics');
89: $Ptr .= '</td></tr>'."\n";
90: $Ptr .= '<tr><td align="right"><b>Sorting Type:</b></td>'."\n";
91: $Ptr .= '<td align="left">'."\n";
92: $Ptr .= &Apache::lonhtmlcommon::AscendOrderOptions(
93: $cache{'ProblemStatisticsAscend'},
94: 'ProblemStatistics',
95: 'Statistics');
1.1 stredwic 96: $Ptr .= '</td></tr>'."\n";
1.25 ! stredwic 97: $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
! 98: $Ptr .= '</td>'."\n";
! 99: $Ptr .= '<td align="left">'."\n";
! 100: my @sections = split(':',$cache{'sectionList'});
! 101: $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
! 102: \@sectionsSelected,
! 103: 'Statistics');
! 104: $Ptr .= '</td></tr>'."\n";
1.20 stredwic 105: $Ptr .= &ProblemStatisticsButtons($cache{'DisplayFormat'},
106: $cache{'DisplayLegend'});
1.2 minaeibi 107: $Ptr .= '</table>';
1.20 stredwic 108: if($cache{'DisplayLegend'} eq 'Show Legend') {
109: $Ptr .= &ProblemStatisticsLegend();
110: }
1.5 minaeibi 111: $r->print($Ptr);
1.13 stredwic 112: $r->rflush();
1.1 stredwic 113:
1.19 stredwic 114: my @Header = ("Homework Sets Order","#Stdnts","Tries","Mod",
115: "Mean","#YES","#yes","%Wrng","DoDiff",
116: "S.D.","Skew.","D.F.1st","D.F.2nd","Disc.");
1.5 minaeibi 117: my $color=&setbgcolor(0);
1.12 minaeibi 118:
1.19 stredwic 119: # my %Discuss=&Apache::loncoursedata::LoadDiscussion($courseID);
1.25 ! stredwic 120: my $lastStatus = (defined($cache{'StatisticsLastStatus'})) ?
! 121: $cache{'StatisticsLastStatus'} : 'Nothing';
! 122: my $whichStudents = join(':::',sort(@$students));
! 123: if(!defined($cache{'StatisticsCached'}) ||
! 124: $lastStatus ne $cache{'Status'} ||
! 125: $whichStudents ne $cache{'StatisticsWhichStudents'}) {
1.24 stredwic 126: if(defined($cache{'StatisticsCached'})) {
127: untie(%cache);
128: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
129: $r->print('Unable to tie database.');
130: return;
131: }
132: my @statkeys = split(':::', $cache{'StatisticsKeys'});
133: delete $cache{'StatisticsKeys'};
134: delete $cache{'StatisticsCached'};
135: foreach(@statkeys) {
136: delete $cache{$_};
137: }
138: }
1.21 stredwic 139: untie(%cache);
140: &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
141: 'true',
142: $cacheDB,
143: 'true',
144: 'true',
145: $courseID,
146: $r, $c);
147: if($c->aborted()) { return; }
148:
149: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
150: $r->print('Unable to tie database.');
151: return;
152: }
153: my ($problemData) = &ExtractStudentData(\%cache, $students);
1.24 stredwic 154: &CalculateStatistics($problemData, \%cache);
1.21 stredwic 155: untie(%cache);
156:
157: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
158: $r->print('Unable to tie database.');
159: return;
160: }
161: foreach(keys(%$problemData)) {
162: $cache{$_} = $problemData->{$_};
163: }
1.24 stredwic 164: $cache{'StatisticsKeys'} = join(':::', keys(%$problemData));
1.21 stredwic 165: $cache{'StatisticsCached'} = 'true';
1.25 ! stredwic 166: $cache{'StatisticsLastStatus'} = $cache{'Status'};
! 167: $cache{'StatisticsWhichStudents'} = $whichStudents;
1.21 stredwic 168: untie(%cache);
169:
170: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
171: $r->print('Unable to tie database.');
172: return;
173: }
174: }
1.25 ! stredwic 175:
1.21 stredwic 176: my $orderedProblems = &SortProblems(\%cache,
177: $cache{'ProblemStatisticsSort'},
178: $cache{'ProblemStatisticsAscend'});
179: &BuildStatisticsTable(\%cache, $cache{'DisplayFormat'}, $orderedProblems,
180: \@Header, $r, $color);
1.19 stredwic 181: untie(%cache);
1.12 minaeibi 182:
1.19 stredwic 183: return;
1.1 stredwic 184: }
185:
1.24 stredwic 186: sub BuildGraphicChart {
187: my ($graph,$cacheDB,$courseDescription,$r)=@_;
188: my %cache;
189: my $max = 0;
190:
191: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
192: return '<html><body>Unable to tie database.</body></html>';
193: }
194:
195: my @problems = split(':::', $cache{'problemList'});
196: my @values = ();
197: foreach (@problems) {
198: my $data = 0;
199: if($graph eq 'DoDiffGraph') {
200: $data = sprintf("%.2f", $cache{$_.':degreeOfDifficulty'}),
201: } else {
202: $data = sprintf("%.1f", $cache{$_.':percentWrong'}),
203: }
204: if($max < $data) {
205: $max = $data;
206: }
207: push(@values, $data);
208: }
209: untie(%cache);
210:
211: my $sendValues = join(',', @values);
212: my $sendCount = scalar(@values);
213:
214: my $title = '';
215: if($graph eq 'DoDiffGraph') {
216: $title = 'Degree-of-Difficulty';
217: } else {
218: $title = 'Wrong-Percentage';
219: }
220: my @GData = ($courseDescription, 'Problems', $title, $max, $sendCount,
221: $sendValues);
222:
223: $r->print('</form>'."\n");
224: $r->print('<IMG src="/cgi-bin/graph.gif?'.(join('&', @GData)).'" border="1" />');
225: $r->print('<form>'."\n");
226:
227: return;
228: }
1.1 stredwic 229:
230: #---- Problem Statistics Web Page ---------------------------------------
231:
232: sub CreateProblemStatisticsTableHeading {
1.19 stredwic 233: my ($headings,$r)=@_;
1.3 minaeibi 234:
1.19 stredwic 235: my $Str='';
236: $Str .= '<tr>'."\n";
237: $Str .= '<th bgcolor="#ffffe6">P#</th>'."\n";
238: foreach(@$headings) {
239: $Str .= '<th bgcolor="#ffffe6">'.'<a href="/adm/statistics?reportSelected=';
240: $Str .= &Apache::lonnet::escape('Problem Statistics');
241: $Str .= '&ProblemStatisticsSort=';
242: $Str .= &Apache::lonnet::escape($_).'">'.$_.'</a> </th>'."\n";
1.1 stredwic 243: }
1.19 stredwic 244: $Str .= "\n".'</tr>'."\n";
1.1 stredwic 245:
1.19 stredwic 246: return $Str;
1.1 stredwic 247: }
1.12 minaeibi 248:
1.1 stredwic 249: sub BuildStatisticsTable {
1.21 stredwic 250: my ($cache,$displayFormat,$orderedProblems,$headings,$r,$color)=@_;
1.5 minaeibi 251:
1.1 stredwic 252: #6666666
253: # my $file="/home/httpd/perl/tmp/183d.txt";
254: # open(OUT, ">$file");
255: #6666666
1.2 minaeibi 256: ## &Apache::lonstatistics::Create_PrgWin($r);
1.1 stredwic 257: ##777777
258: ## my (%Activity) = &LoadActivityLog();
259: ## $r->print('<script>popwin.document.popremain.remaining.value="'.
260: ## 'Loading Discussion...";</script>');
261: ## my ($doDiffFile) = &LoadDoDiffFile();
262:
1.5 minaeibi 263: ##777777
264: ## $Str .= &Classify($discriminantFactor, $students);
265:
1.21 stredwic 266: if($displayFormat ne 'Display CSV Format') {
1.19 stredwic 267: $r->print('<table border="0"><tr><td bgcolor="#777777">'."\n");
268: $r->print('<table border="0" cellpadding="3">'."\n");
269: $r->print(&CreateProblemStatisticsTableHeading($headings, $r));
270: } else {
271: $r->print('<br>');
272: }
1.1 stredwic 273:
1.19 stredwic 274: my $count = 1;
1.21 stredwic 275: foreach(@$orderedProblems) {
1.19 stredwic 276: my ($sequence,$problem,$part)=split(':', $_);
1.25 ! stredwic 277: if($cache->{'StatisticsMaps'} ne 'All Maps' &&
! 278: $cache->{'StatisticsMaps'} ne $cache->{$sequence.':title'}) {
1.23 stredwic 279: next;
280: }
1.19 stredwic 281:
1.21 stredwic 282: my $ref = '<a href="'.$cache->{$problem.':source'}.
283: '" target="_blank">'.$cache->{$problem.':title'}.'</a>';
284: # my $ref = $cache->{$problem.':title'};
1.19 stredwic 285: my $title = $cache->{$problem.':title'};
286: my $source = 'source';
287: my $tableData = join('&', $ref, $title, $source,
1.21 stredwic 288: $cache->{$_.':studentCount'},
289: $cache->{$_.':totalTries'},
290: $cache->{$_.':maxTries'},
291: sprintf("%.2f", $cache->{$_.':mean'}),
292: $cache->{$_.':correct'},
293: $cache->{$_.':correctByOverride'},
294: sprintf("%.1f", $cache->{$_.':percentWrong'}),
295: sprintf("%.2f", $cache->{$_.':degreeOfDifficulty'}),
296: sprintf("%.1f", $cache->{$_.':standardDeviation'}),
297: sprintf("%.1f", $cache->{$_.':skewness'}),
298: sprintf("%.2f", $cache->{$_.':discriminationFactor1'}),
299: sprintf("%.2f", $cache->{$_.':discriminationFactor2'}),
300: 0); # 0 is for discussion, need to figure out
1.1 stredwic 301:
1.19 stredwic 302: &TableRow($displayFormat,$tableData,$count,$r,$color);
303: $count++;
304: }
305: if($cache->{'DisplayFormat'} ne 'Display CSV Format') {
306: $r->print('</table>'."\n");
1.1 stredwic 307: }
1.19 stredwic 308: $r->print('</td></tr></table>');
1.14 minaeibi 309: #6666666
1.25 ! stredwic 310: # $r->print('<br>'.$out.'&'.$DoD);
! 311: # print (OUT $out.'@'.$DoD.'&');
! 312: #6666666
! 313:
! 314: #6666666
1.1 stredwic 315: # close( OUT );
316: #666666
1.21 stredwic 317: return;
1.1 stredwic 318: }
319:
320: sub TableRow {
1.19 stredwic 321: my ($displayFormat,$Str,$RealIdx,$r,$color)=@_;
322: my($ref,$title,$source,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override,
1.1 stredwic 323: $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$DiscNo,$Prob)=split(/\&/,$Str);
1.8 minaeibi 324: my $Ptr;
1.19 stredwic 325: if($displayFormat eq 'Display CSV Format') {
1.8 minaeibi 326: $Ptr="\n".'<br>'.
1.19 stredwic 327: "\n".'"'.$RealIdx.'",'.
328: "\n".'"'.$title.'",'.
329: "\n".'"'.$source.'",'.
1.8 minaeibi 330: "\n".'"'.$StdNo.'",'.
331: "\n".'"'.$TotalTries.'",'.
332: "\n".'"'.$MxTries.'",'.
333: "\n".'"'.$Avg.'",'.
334: "\n".'"'.$YES.'",'.
335: "\n".'"'.$Override.'",'.
336: "\n".'"'.$Wrng.'",'.
337: "\n".'"'.$DoD.'",'.
338: "\n".'"'.$SD.'",'.
339: "\n".'"'.$Sk.'",'.
340: "\n".'"'.$_D1.'",'.
341: "\n".'"'.$_D2.'"'.
342: "\n".'"'.$DiscNo.'"';
1.1 stredwic 343:
344: $r->print("\n".$Ptr);
1.8 minaeibi 345: } else {
346: $Ptr="\n".'<tr>'.
1.19 stredwic 347: "\n".'<td bgcolor="#ffffe6">'.$RealIdx.'</td>'.
348: "\n".'<td bgcolor="#ffffe6">'.$ref.'</td>'.
1.8 minaeibi 349: "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$StdNo.'</td>'.
350: "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$TotalTries.'</td>'.
351: "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$MxTries.'</td>'.
352: "\n".'<td bgcolor='.$color->{"gb"}.'>'.$Avg.'</td>'.
353: "\n".'<td bgcolor='.$color->{"gb"}.'> '.$YES.'</td>'.
354: "\n".'<td bgcolor='.$color->{"gb"}.'> '.$Override.'</td>'.
355: "\n".'<td bgcolor='.$color->{"red"}.'> '.$Wrng.'</td>'.
356: "\n".'<td bgcolor='.$color->{"red"}.'> '.$DoD.'</td>'.
357: "\n".'<td bgcolor='.$color->{"green"}.'> '.$SD.'</td>'.
358: "\n".'<td bgcolor='.$color->{"green"}.'> '.$Sk.'</td>'.
359: "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D1.'</td>'.
360: "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D2.'</td>'.
361: "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$DiscNo.'</td>';
1.1 stredwic 362: $r->print("\n".$Ptr.'</tr>' );
363: }
1.19 stredwic 364:
365: return;
1.1 stredwic 366: }
1.5 minaeibi 367:
368: # For loading the colored table for display or un-colored for print
369: sub setbgcolor {
370: my $PrintTable=shift;
371: my %color;
372: if ($PrintTable){
373: $color{"gb"}="#FFFFFF";
374: $color{"red"}="#FFFFFF";
375: $color{"yellow"}="#FFFFFF";
376: $color{"green"}="#FFFFFF";
377: $color{"purple"}="#FFFFFF";
378: } else {
379: $color{"gb"}="#DDFFFF";
380: $color{"red"}="#FFDDDD";
381: $color{"yellow"}="#EEFFCC";
382: $color{"green"}="#DDFFDD";
383: $color{"purple"}="#FFDDFF";
384: }
385:
386: return \%color;
387: }
388:
1.1 stredwic 389: sub ProblemStatisticsButtons {
1.20 stredwic 390: my ($displayFormat, $displayLegend)=@_;
1.1 stredwic 391:
392: my $Ptr = '<tr><td></td><td align="left">';
393: $Ptr .= '<input type="submit" name="DoDiffGraph" ';
394: $Ptr .= 'value="DoDiff Graph" />'."\n";
395: $Ptr .= ' ';
396: $Ptr .= '<input type="submit" name="PercentWrongGraph" ';
397: $Ptr .= 'value="%Wrong Graph" />'."\n";
1.20 stredwic 398: $Ptr .= '</td></tr><tr><td></td><td>'."\n";
399: $Ptr .= '<input type="submit" name="DisplayLegend" ';
400: if($displayLegend eq 'Show Legend') {
401: $Ptr .= 'value="Hide Legend" />'."\n";
402: } else {
403: $Ptr .= 'value="Show Legend" />'."\n";
404: }
1.1 stredwic 405: $Ptr .= ' ';
406: $Ptr .= '<input type="submit" name="DisplayCSVFormat" ';
407: if($displayFormat eq 'Display CSV Format') {
1.9 stredwic 408: $Ptr .= 'value="Display Table Format" />'."\n";
409: } else {
1.1 stredwic 410: $Ptr .= 'value="Display CSV Format" />'."\n";
411: }
412: $Ptr .= '</td></tr>';
413:
414: return $Ptr;
415: }
416:
417: sub ProblemStatisticsLegend {
418: my $Ptr = '';
419: $Ptr = '<table border="0">';
420: $Ptr .= '<tr><td>';
1.6 minaeibi 421: $Ptr .= '<b>#Stdnts</b></td>';
1.19 stredwic 422: $Ptr .= '<td>Total number of students attempted the problem.';
1.1 stredwic 423: $Ptr .= '</td></tr><tr><td>';
1.6 minaeibi 424: $Ptr .= '<b>Tries</b></td>';
1.19 stredwic 425: $Ptr .= '<td>Total number of tries for solving the problem.';
1.1 stredwic 426: $Ptr .= '</td></tr><tr><td>';
1.6 minaeibi 427: $Ptr .= '<b>Mod</b></td>';
1.19 stredwic 428: $Ptr .= '<td>Largest number of tries for solving the problem by a student.';
1.1 stredwic 429: $Ptr .= '</td></tr><tr><td>';
1.6 minaeibi 430: $Ptr .= '<b>Mean</b></td>';
1.19 stredwic 431: $Ptr .= '<td>Average number of tries. [ Tries / #Stdnts ]';
1.1 stredwic 432: $Ptr .= '</td></tr><tr><td>';
1.6 minaeibi 433: $Ptr .= '<b>#YES</b></td>';
1.1 stredwic 434: $Ptr .= '<td>Number of students solved the problem correctly.';
435: $Ptr .= '</td></tr><tr><td>';
1.6 minaeibi 436: $Ptr .= '<b>#yes</b></td>';
1.1 stredwic 437: $Ptr .= '<td>Number of students solved the problem by override.';
438: $Ptr .= '</td></tr><tr><td>';
1.19 stredwic 439: $Ptr .= '<b>%Wrong</b></td>';
440: $Ptr .= '<td>Percentage of students who tried to solve the problem ';
441: $Ptr .= 'but is still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]';
1.1 stredwic 442: $Ptr .= '</td></tr><tr><td>';
1.6 minaeibi 443: $Ptr .= '<b>DoDiff</b></td>';
1.1 stredwic 444: $Ptr .= '<td>Degree of Difficulty of the problem. ';
445: $Ptr .= '[ 1 - ((#YES+#yes) / Tries) ]';
446: $Ptr .= '</td></tr><tr><td>';
1.6 minaeibi 447: $Ptr .= '<b>S.D.</b></td>';
1.1 stredwic 448: $Ptr .= '<td>Standard Deviation of the tries. ';
449: $Ptr .= '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) ';
450: $Ptr .= 'where Xi denotes every student\'s tries ]';
451: $Ptr .= '</td></tr><tr><td>';
1.6 minaeibi 452: $Ptr .= '<b>Skew.</b></td>';
1.1 stredwic 453: $Ptr .= '<td>Skewness of the students tries.';
454: $Ptr .= '[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]';
455: $Ptr .= '</td></tr><tr><td>';
1.6 minaeibi 456: $Ptr .= '<b>Dis.F.</b></td>';
1.1 stredwic 457: $Ptr .= '<td>Discrimination Factor: A Standard for evaluating the ';
458: $Ptr .= 'problem according to a Criterion<br>';
459: $Ptr .= '<b>[Applied Criterion in %27 Upper Students - ';
460: $Ptr .= 'Applied the same Criterion in %27 Lower Students]</b><br>';
461: $Ptr .= '<b>1st Criterion</b> for Sorting the Students: ';
462: $Ptr .= '<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>';
463: $Ptr .= '<b>2nd Criterion</b> for Sorting the Students: ';
464: $Ptr .= '<b>Total number of Correct Answers / Total Number of Tries</b>';
465: $Ptr .= '</td></tr>';
466: $Ptr .= '<tr><td><b>Disc.</b></td>';
467: $Ptr .= '<td>Number of Students had at least one discussion.';
468: $Ptr .= '</td></tr></table>';
469:
470: return $Ptr;
471: }
472:
1.4 minaeibi 473: #------- Processing upperlist and lowerlist according to each problem
1.19 stredwic 474:
475: sub ExtractStudentData {
476: my ($cache, $students)=@_;
477:
478: #$Apache::lonxml::debug=1;
479: #&Apache::lonhomework::showhash(%$cache);
480: #$Apache::lonxml::debug=0;
481:
482: my @problemList=();
483: my %problemData;
484: foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
485: foreach my $problemID (split(':', $cache->{$sequence.':problems'})) {
486: foreach my $part (split(/\:/,$cache->{$sequence.':'.
487: $problemID.
488: ':parts'})) {
489: my $id = $sequence.':'.$problemID.':'.$part;
490: push(@problemList, $id);
491: my $totalTries = 0;
492: my $totalAwarded = 0;
493: my $correct = 0;
494: my $correctByOverride = 0;
495: my $studentCount = 0;
496: my $maxTries = 0;
497: my $totalFirst = 0;
498: my @studentTries=();
499: foreach(@$students) {
500: my $code = $cache->{"$_:$problemID:$part:code"};
501:
502: if(defined($cache->{$_.':error'}) || $code eq ' ' ||
503: $cache->{"$_:$problemID:NoVersion"} eq 'true') {
504: next;
505: }
506:
507: $studentCount++;
508: my $tries = $cache->{"$_:$problemID:$part:tries"};
509: if($maxTries < $tries) {
510: $maxTries = $tries;
511: }
512: $totalTries += $tries;
513: push(@studentTries, $tries);
514:
515: my $awarded = $cache->{"$_:$problemID:$part:awarded"};
516: $totalAwarded += $awarded;
517:
518: if($code eq '*') {
519: $correct++;
520: if($tries == 1) {
521: $totalFirst++;
522: }
523: } elsif($code eq '+') {
524: $correctByOverride++;
525: }
526: }
527:
528: $problemData{$id.':sequenceTitle'} =
529: $cache->{$sequence.':title'};
530: $problemData{$id.':studentCount'} = $studentCount;
531: $problemData{$id.':totalTries'} = $totalTries;
532: $problemData{$id.':studentTries'} = \@studentTries;
533: $problemData{$id.':totalAwarded'} = $totalAwarded;
534: $problemData{$id.':correct'} = $correct;
535: $problemData{$id.':correctByOverride'} = $correctByOverride;
536: $problemData{$id.':wrong'} = $studentCount -
537: ($correct + $correctByOverride);
538: $problemData{$id.':maxTries'} = $maxTries;
539: $problemData{$id.':totalFirst'} = $totalFirst;
540: }
541: }
542: }
543:
1.24 stredwic 544: my @upperStudents1=();
545: my @lowerStudents1=();
546: my @upperStudents2=();
547: my @lowerStudents2=();
548: my $upperCount = int(0.27*scalar(@$students));
549: # Discriminant Factor criterion 1
550: my $sortedStudents = &SortDivideByTries($students,$cache,':totalAwarded');
551:
552: for(my $i=0; $i<$upperCount; $i++) {
553: push(@lowerStudents1, $sortedStudents->[$i]);
554: push(@upperStudents1, $sortedStudents->[(scalar(@$students)-$i-1)]);
555: }
556:
557: $problemData{'studentsUpperListCriterion1'}=join(':::', @upperStudents1);
558: $problemData{'studentsLowerListCriterion1'}=join(':::', @lowerStudents1);
559:
560: # Discriminant Factor criterion 2
561: $sortedStudents = &SortDivideByTries($students, $cache, ':totalSolved');
562:
563: for(my $i=0; $i<$upperCount; $i++) {
564: push(@lowerStudents2, $sortedStudents->[$i]);
565: push(@upperStudents2, $sortedStudents->[(scalar(@$students)-$i-1)]);
566: }
567: $problemData{'studentsUpperListCriterion2'}=join(':::', @upperStudents2);
568: $problemData{'studentsLowerListCriterion2'}=join(':::', @lowerStudents2);
569:
1.21 stredwic 570: $problemData{'problemList'} = join(':::', @problemList);
1.19 stredwic 571: # $Discussed=0;
572: # if($Discuss->{"$name:$problem"}) {
573: # $TotDiscuss++;
574: # $Discussed=1;
575: # }
576:
577: return \%problemData;
578: }
579:
1.24 stredwic 580: sub SortDivideByTries {
581: my ($toSort, $data, $sortOn)=@_;
582: my @orderedData = sort { ($data->{$a.':totalTries'}) ?
583: ($data->{$a.$sortOn}/$data->{$a.':totalTries'}):0
584: <=>
585: ($data->{$b.':totalTries'}) ?
586: ($data->{$b.$sortOn}/$data->{$b.':totalTries'}):0
587: } @$toSort;
588:
589: return \@orderedData;
590: }
591:
1.19 stredwic 592: sub SortProblems {
593: my ($problemData,$sortBy,$ascend)=@_;
594:
1.21 stredwic 595: my @problems = split(':::', $problemData->{'problemList'});
1.19 stredwic 596: if($sortBy eq "Homework Sets Order") {
1.21 stredwic 597: return \@problems;
1.19 stredwic 598: }
599:
600: my $data;
601:
602: if ($sortBy eq "#Stdnts") { $data = ':studentCount'; }
603: elsif($sortBy eq "Tries") { $data = ':totalTries'; }
604: elsif($sortBy eq "Mod") { $data = ':maxTries'; }
605: elsif($sortBy eq "Mean") { $data = ':mean'; }
606: elsif($sortBy eq "#YES") { $data = ':correct'; }
607: elsif($sortBy eq "#yes") { $data = ':correctByOverride'; }
608: elsif($sortBy eq "%Wrng") { $data = ':percentWrong'; }
609: elsif($sortBy eq "DoDiff") { $data = ':degreeOfDifficulty'; }
610: elsif($sortBy eq "S.D.") { $data = ':standardDeviation'; }
611: elsif($sortBy eq "Skew.") { $data = ':skewness'; }
612: elsif($sortBy eq "D.F.1st") { $data = ':discriminantFactor1'; }
613: elsif($sortBy eq "D.F.2nd") { $data = ':discriminantFactor2'; }
614: elsif($sortBy eq "Disc.") { $data = ''; }
1.21 stredwic 615: else { return \@problems; }
1.19 stredwic 616:
617: my @orderedProblems =
618: sort { $problemData->{$a.$data} <=> $problemData->{$b.$data} }
1.21 stredwic 619: @problems;
1.19 stredwic 620: if($ascend eq 'Descending') {
621: @orderedProblems = reverse(@orderedProblems);
622: }
623:
1.21 stredwic 624: return \@orderedProblems;
1.19 stredwic 625: }
626:
627: sub CalculateStatistics {
1.24 stredwic 628: my ($data, $cache)=@_;
1.19 stredwic 629:
1.21 stredwic 630: my @problems = split(':::', $data->{'problemList'});
631: foreach(@problems) {
1.19 stredwic 632: # Mean
633: $data->{$_.':mean'} = ($data->{$_.':studentCount'}) ?
634: ($data->{$_.':totalTries'} / $data->{$_.':studentCount'}) : 0;
635:
636: # %Wrong
637: $data->{$_.':percentWrong'} = ($data->{$_.':studentCount'}) ?
638: (($data->{$_.':wrong'} / $data->{$_.':studentCount'}) * 100.0) :
639: 100.0;
640:
641: # Degree of Difficulty
642: $data->{$_.':degreeOfDifficulty'} = ($data->{$_.':totalTries'}) ?
643: (1 - (($data->{$_.':correct'} + $data->{$_.':correctByOverride'}) /
644: $data->{$_.':totalTries'})) : 0;
645:
646: # Factor in mean
647: my $studentTries = $data->{$_.':studentTries'};
648: foreach(my $index=0; $index < scalar(@$studentTries); $index++) {
649: $studentTries->[$index] -= $data->{$_.':mean'};
650: }
651: my $sumSquared = 0;
652: my $sumCubed = 0;
653: foreach(@$studentTries) {
654: my $squared = ($_ * $_);
655: my $cubed = ($squared * $_);
656: $sumSquared += $squared;
657: $sumCubed += $cubed;
658: }
659:
660: # Standard deviation
661: $data->{$_.':standardDeviation'} = ($data->{$_.':studentCount'} - 1) ?
662: ((sqrt($sumSquared)) / ($data->{$_.':studentCount'} - 1)) : 0;
663:
664: # Skewness
665: my $standardDeviation = $data->{$_.':standardDeviation'};
666: $data->{$_.':skewness'} = ($data->{$_.':standardDeviation'}) ?
667: (((sqrt($sumSquared)) / $data->{$_.':studentCount'}) /
668: ($standardDeviation * $standardDeviation * $standardDeviation)) :
669: 0;
670:
671: # Discrimination Factor 1
1.24 stredwic 672: my ($sequence, $problem, $part) = split(':', $_);
1.19 stredwic 673:
1.24 stredwic 674: my @upper1 = split(':::', $data->{'studentsUpperListCriterion1'});
675: my @lower1 = split(':::', $data->{'studentsLowerListCriterion1'});
1.19 stredwic 676:
1.24 stredwic 677: my $upper1Sum=0;
678: foreach my $name (@upper1) {
679: $upper1Sum += $cache->{"$name:$problem:$part:awarded"};
680: }
1.25 ! stredwic 681: $upper1Sum = (scalar(@upper1)) ? ($upper1Sum/(scalar(@upper1))) : 0;
1.19 stredwic 682:
1.24 stredwic 683: my $lower1Sum=0;
684: foreach my $name (@lower1) {
685: $lower1Sum += $cache->{"$name:$problem:$part:awarded"};
1.4 minaeibi 686: }
1.25 ! stredwic 687: $lower1Sum = (scalar(@lower1)) ? ($lower1Sum/(scalar(@lower1))) : 0;
1.4 minaeibi 688:
1.24 stredwic 689: $data->{$_.':discriminationFactor1'} = $upper1Sum - $lower1Sum;
1.4 minaeibi 690:
1.24 stredwic 691: # Discrimination Factor 2
692: my @upper2 = split(':::', $data->{'studentsUpperListCriterion2'});
693: my @lower2 = split(':::', $data->{'studentsLowerListCriterion2'});
1.1 stredwic 694:
1.24 stredwic 695: my $upper2Sum=0;
696: foreach my $name (@upper2) {
697: $upper2Sum += $cache->{"$name:$problem:$part:awarded"};
698: }
1.25 ! stredwic 699: $upper2Sum = (scalar(@upper2)) ? ($upper2Sum/(scalar(@upper2))) : 0;
1.14 minaeibi 700:
1.24 stredwic 701: my $lower2Sum=0;
702: foreach my $name (@lower2) {
703: $lower2Sum += $cache->{"$name:$problem:$part:awarded"};
1.22 stredwic 704: }
1.25 ! stredwic 705: $lower2Sum = (scalar(@lower2)) ? ($lower2Sum/(scalar(@lower2))) : 0;
1.22 stredwic 706:
1.24 stredwic 707: $data->{$_.':discriminationFactor2'} = $upper2Sum - $lower2Sum;
1.16 minaeibi 708: }
709:
710: return;
1.1 stredwic 711: }
1.24 stredwic 712:
713: #---- END Problem Statistics Web Page ----------------------------------------
1.4 minaeibi 714:
1.1 stredwic 715: 1;
716: __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