Annotation of loncom/interface/statistics/lonpercentage.pm, revision 1.7
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
1.7 ! minaeibi 4: # $Id: lonpercentage.pm,v 1.6 2003/01/13 00:15:16 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: ###
29:
30: package Apache::lonpercentage;
31:
32: use strict;
33: use Apache::lonhtmlcommon;
34: use Apache::loncoursedata;
35: use GDBM_File;
36:
37:
38: sub BuildPercentageGraph {
39: my ($cacheDB, $students, $courseID, $c, $r)=@_;
40:
41: my %cache;
42: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
43: $r->print('Unable to tie database.6');
44: return;
45: }
46:
47: $r->print(&CreateInterface(\%cache));
48: $r->rflush();
49: untie(%cache);
50:
51: my ($result) = &InitializeSelectedStudents($cacheDB, $students,
52: $courseID, $c, $r);
53: if($result ne 'OK' || $c->aborted()) {
54: return;
55: }
56:
57: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
58: $r->print('Unable to tie database.6');
59: return;
60: }
61:
1.4 minaeibi 62: my ($Ptr, $percentage) = &GraphData(\%cache, $students,$r);
63: $r->print($Ptr.'<br>');
1.1 stredwic 64:
65: $r->print(&TableData(\%cache, $percentage));
66:
67: untie(%cache);
68:
69: return;
70: }
71:
72: sub CreateInterface {
73: my ($cache)=@_;
74:
75: my $Ptr = '';
76: $Ptr .= '<table border="0" cellspacing="5"><tbody>';
77: $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
78: $Ptr .= '<td align="left">';
79: $Ptr .= &Apache::lonhtmlcommon::MapOptions($cache, 'Statistics',
80: 'Statistics');
81: $Ptr .= '</td>'."\n";
82:
83: my $sequence = $cache->{'StatisticsMaps'};
84: if($sequence ne 'All Maps') {
85: $Ptr .= '<td align="right">'."\n";
86: $Ptr .= &Apache::lonhtmlcommon::ProblemOptions($cache,
87: 'Statistics',
88: $sequence,
89: 'Statistics');
90: $Ptr .= '<td>'."\n";
91:
92: my $problem = $cache->{'StatisticsProblemSelect'};
93: if($problem ne 'All Problems') {
94: my $parts = &GetParts($cache, $sequence, $problem);
95: if(scalar(@$parts) > 0) {
96: $Ptr .= '<td align="right">'."\n";
97: $Ptr .= &Apache::lonhtmlcommon::PartOptions($cache,
98: 'Statistics',
99: $parts,
100: 'Statistics');
101: $Ptr .= '</td>'."\n";
102: }
103: }
104: }
105:
106: $Ptr .= '</tr>'."\n";
107:
108: $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
109: $Ptr .= '</td>'."\n";
110: $Ptr .= '<td align="left">'."\n";
111: my @sections = split(':',$cache->{'sectionList'});
112: my @sectionsSelected = split(':',$cache->{'sectionsSelected'});
113: $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
114: \@sectionsSelected,
115: 'Statistics');
116: $Ptr .= '</td></tr>'."\n";
117: $Ptr .= '</table>';
118:
119: return $Ptr;
120: }
121:
122: sub GetParts {
123: my ($cache,$sequence,$problem)=@_;
124: my @parts = ();
125:
126: foreach my $sequenceNumber (split(':',$cache->{'orderedSequences'})) {
127: if($cache->{$sequenceNumber.':title'} eq $sequence) {
128: foreach my $problemNumber (split(':',
129: $cache->{$sequenceNumber.':problems'})) {
130: if($cache->{$problemNumber.':title'} eq $problem) {
131: @parts = split(':',
132: $cache->{$sequenceNumber.':'.$problemNumber.':parts'});
133: }
134: }
135: }
136: }
137:
138: return \@parts;
139: }
140:
141: sub InitializeSelectedStudents {
142: my ($cacheDB, $students, $courseID, $c, $r)=@_;
143: my %cache;
144:
145: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
146: $r->print('Unable to tie database1.1.');
147: return ('ERROR');
148: }
149:
150: # Remove students who don't have the proper section.
151: my @sectionsSelected = split(':',$cache{'sectionsSelected'});
152: for(my $studentIndex=((scalar @$students)-1); $studentIndex>=0;
153: $studentIndex--) {
154: my $value = $cache{$students->[$studentIndex].':section'};
155: my $found = 0;
156: foreach (@sectionsSelected) {
157: if($_ eq 'none') {
158: if($value eq '' || !defined($value) || $value eq ' ') {
159: $found = 1;
160: last;
161: }
162: } else {
163: if($value eq $_) {
164: $found = 1;
165: last;
166: }
167: }
168: }
169: if($found == 0) {
170: splice(@$students, $studentIndex, 1);
171: }
172: }
173:
174: untie(%cache);
175:
176: &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
177: 'true',
178: $cacheDB,
179: 'true',
180: 'true',
181: $courseID,
182: $r, $c);
183:
184: return ('OK');
185: }
186:
187: sub GraphData {
1.4 minaeibi 188: my ($cache,$students,$r)=@_;
1.1 stredwic 189:
190: my $sequenceSelected = $cache->{'StatisticsMaps'};
191: my $problemSelected = $cache->{'StatisticsProblemSelect'};
192: my $partSelected = $cache->{'StatisticsPartSelect'};
193:
194: my %percentages;
195: my $Ptr = '';
1.6 minaeibi 196: my $totalProblems = 0;
1.1 stredwic 197:
198: foreach(@$students) {
199: my $totalCorrect = 0;
1.6 minaeibi 200: $totalProblems = 0;
1.1 stredwic 201:
202: foreach my $sequence (split(':',$cache->{'orderedSequences'})) {
203: next if($cache->{$sequence.':title'} ne $sequenceSelected &&
204: $sequenceSelected ne 'All Maps');
205: foreach my $problem (split(':',$cache->{$sequence.':problems'})) {
206: next if($cache->{$problem.':title'} ne $problemSelected &&
207: $problemSelected ne 'All Problems' &&
208: $sequenceSelected ne 'All Maps');
209: foreach my $part (split(':',$cache->{$sequence.':'.$problem.
210: ':parts'})) {
211: next if($part ne $partSelected &&
212: $partSelected ne 'All Parts' &&
213: $problemSelected ne 'All Problems' &&
214: $sequenceSelected ne 'All Maps');
215: my $code = $cache->{$_.':'.$problem.':'.$part.':code'};
216: if($code eq '*' || $code eq '+') {
217: $totalCorrect++;
218: $totalProblems++;
219: } elsif($code ne 'x') {
220: $totalProblems++;
221: }
222: }
223: }
224: }
1.6 minaeibi 225: my $percent;
226: if ( $totalProblems >= 100 ) {
227: $percent = sprintf("%d", ($totalProblems) ?
228: (($totalCorrect/$totalProblems)*100) : 0);
229: } else {
230: $percent = sprintf("%d", ($totalProblems) ? $totalCorrect : 0);
231: }
1.1 stredwic 232: if(defined($percentages{$percent})) {
233: $percentages{$percent} .= ':::'.$_;
234: } else {
235: $percentages{$percent} = $_;
236: }
237: }
238:
239: my @percent = ();
240: my @percentCount = ();
241: my $max = 0;
1.4 minaeibi 242: my $pno = 0;
1.6 minaeibi 243:
1.4 minaeibi 244: foreach my $key (sort NumericSort keys(%percentages)) {
1.1 stredwic 245: push(@percent, $key);
1.2 stredwic 246: my @temp = split(':::', $percentages{$key});
247: my $count = scalar(@temp);
1.1 stredwic 248: if($count > $max) {
249: $max = $count;
250: }
251: push(@percentCount, $count);
1.4 minaeibi 252: $pno++;
1.1 stredwic 253: }
254:
1.5 minaeibi 255: my $cId=0;
256: my @data1=();
257: my @data2=();
258: for (my $nIdx=0; $nIdx<$pno; $nIdx++ ) {
259: $data1[$cId]=$percent[$nIdx];
260: $data2[$cId]=$percentCount[$nIdx];
261: my $cr=$percent[$nIdx+1];
262: while ($data1[$cId]<$cr) {
263: $cId++;
264: $data1[$cId]=$cId;
265: $data2[$cId]=0;
266: }
267: }
1.4 minaeibi 268:
1.7 ! minaeibi 269: my $xlabel;
! 270: my $Freq;
! 271: if ($totalProblems >= 100 ) {
! 272: $xlabel = 'Percentage_of_Problems_Correct';
! 273: $Freq=100;
! 274: } else {
! 275: $xlabel = 'Number_of_Problems_Correct';
! 276: $Freq = $cId;
! 277: }
! 278:
! 279: # $r->print('<br>Freq='.$Freq);
1.6 minaeibi 280: # $r->print('<br>max='.$max);
281: # $r->print('<br> percentcount='.join(',', @percentCount));
282: # $r->print('<br> percent='.join(',', @percent));
1.5 minaeibi 283: # $r->print('<br> percentcount='.join(',', @data1));
284: # $r->print('<br> percent='.join(',', @data2));
1.1 stredwic 285:
1.6 minaeibi 286: my @GData = ("Percentage",$xlabel,
1.7 ! minaeibi 287: 'Number_of_Students',$max,$Freq,
1.5 minaeibi 288: join(',',@data1), join(',', @data2));
1.4 minaeibi 289:
1.1 stredwic 290: $Ptr .= '</form>'."\n";
1.3 albertel 291: $Ptr .= '<IMG src="/cgi-bin/graph.png?'.(join('&', @GData));
1.1 stredwic 292: $Ptr .= '" border="1" />';
293: $Ptr .= '<form>'."\n";
294:
295: return ($Ptr, \%percentages);
296: }
297:
1.4 minaeibi 298: sub NumericSort {
299: $a <=> $b;
300: }
301:
1.1 stredwic 302: sub TableData {
303: my($cache,$percentage)=@_;
304: my $Ptr;
305:
1.4 minaeibi 306: $Ptr .= '<table border="0"><tr><td bgcolor="#D7D7D7">'."\n";
1.1 stredwic 307: $Ptr .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
308:
309: $Ptr .= '<tr>'."\n";
1.4 minaeibi 310: $Ptr .= '<td>% Correct</td>'.
311: '<td>Frequency</td>'.
312: '<td>Students</td>';
1.1 stredwic 313: $Ptr .= '</tr>'."\n";
314:
315: my $alternate=0;
1.4 minaeibi 316: foreach (sort NumericSort keys(%$percentage)) {
317:
318: my @temp = split(':::', $percentage->{$_});
319: my $count = scalar(@temp);
320:
1.1 stredwic 321: if($alternate) {
322: $Ptr .= '<tr bgcolor="#ffffe6">';
323: } else {
324: $Ptr .= '<tr bgcolor="#ffffc6">';
325: }
326: $alternate = ($alternate + 1) % 2;
327:
1.4 minaeibi 328: $Ptr .= '<td>'.$_.'</td>';
329: $Ptr .= '<td>'.$count.'</td><td>';
1.1 stredwic 330:
331: foreach my $name (sort(split(':::', $percentage->{$_}))) {
332: $Ptr .= '<a href="/adm/statistics?reportSelected=';
333: $Ptr .= &Apache::lonnet::escape('Student Assessment');
334: $Ptr .= '&StudentAssessmentStudent=';
335: $Ptr .= &Apache::lonnet::escape($cache->{$name.':fullname'}).'">';
336: $Ptr .= $cache->{$name.':fullname'};
337: $Ptr .= '</a>,  ';
338: }
339:
340: $Ptr .= '</td></tr>'."\n";
341: }
342:
343: $Ptr .= '</tr>'."\n";
344: $Ptr .= '</table></td></tr></table>'."\n";
345:
346: return $Ptr;
347: }
348:
349: 1;
350: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>