Annotation of loncom/interface/statistics/lonpercentage.pm, revision 1.11
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: #
1.11 ! bisitz 3: # $Id: lonpercentage.pm,v 1.10 2006/05/30 12:46:49 www Exp $
1.1 stredwic 4: #
5: # Copyright Michigan State University Board of Trustees
6: #
7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
8: #
9: # LON-CAPA is free software; you can redistribute it and/or modify
10: # it under the terms of the GNU General Public License as published by
11: # the Free Software Foundation; either version 2 of the License, or
12: # (at your option) any later version.
13: #
14: # LON-CAPA is distributed in the hope that it will be useful,
15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17: # GNU General Public License for more details.
18: #
19: # You should have received a copy of the GNU General Public License
20: # along with LON-CAPA; if not, write to the Free Software
21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22: #
23: # /home/httpd/html/adm/gpl.txt
24: #
25: # http://www.lon-capa.org/
26: #
27: ###
28:
29: package Apache::lonpercentage;
30:
31: use strict;
32: use Apache::lonhtmlcommon;
33: use Apache::loncoursedata;
34: use GDBM_File;
1.10 www 35: use lib '/home/httpd/lib/perl/';
36: use LONCAPA;
37:
1.1 stredwic 38:
39:
40: sub BuildPercentageGraph {
41: my ($cacheDB, $students, $courseID, $c, $r)=@_;
42:
43: my %cache;
44: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
45: $r->print('Unable to tie database.6');
46: return;
47: }
48:
49: $r->print(&CreateInterface(\%cache));
50: $r->rflush();
51: untie(%cache);
52:
53: my ($result) = &InitializeSelectedStudents($cacheDB, $students,
54: $courseID, $c, $r);
55: if($result ne 'OK' || $c->aborted()) {
56: return;
57: }
58:
59: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
60: $r->print('Unable to tie database.6');
61: return;
62: }
63:
1.4 minaeibi 64: my ($Ptr, $percentage) = &GraphData(\%cache, $students,$r);
65: $r->print($Ptr.'<br>');
1.1 stredwic 66:
67: $r->print(&TableData(\%cache, $percentage));
68:
69: untie(%cache);
70:
71: return;
72: }
73:
74: sub CreateInterface {
75: my ($cache)=@_;
76:
77: my $Ptr = '';
78: $Ptr .= '<table border="0" cellspacing="5"><tbody>';
79: $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
80: $Ptr .= '<td align="left">';
81: $Ptr .= &Apache::lonhtmlcommon::MapOptions($cache, 'Statistics',
82: 'Statistics');
83: $Ptr .= '</td>'."\n";
84:
85: my $sequence = $cache->{'StatisticsMaps'};
86: if($sequence ne 'All Maps') {
87: $Ptr .= '<td align="right">'."\n";
88: $Ptr .= &Apache::lonhtmlcommon::ProblemOptions($cache,
89: 'Statistics',
90: $sequence,
91: 'Statistics');
92: $Ptr .= '<td>'."\n";
93:
94: my $problem = $cache->{'StatisticsProblemSelect'};
95: if($problem ne 'All Problems') {
96: my $parts = &GetParts($cache, $sequence, $problem);
97: if(scalar(@$parts) > 0) {
98: $Ptr .= '<td align="right">'."\n";
99: $Ptr .= &Apache::lonhtmlcommon::PartOptions($cache,
100: 'Statistics',
101: $parts,
102: 'Statistics');
103: $Ptr .= '</td>'."\n";
104: }
105: }
106: }
107:
108: $Ptr .= '</tr>'."\n";
109:
110: $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
111: $Ptr .= '</td>'."\n";
112: $Ptr .= '<td align="left">'."\n";
113: my @sections = split(':',$cache->{'sectionList'});
114: my @sectionsSelected = split(':',$cache->{'sectionsSelected'});
1.9 matthew 115: $Ptr .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
1.1 stredwic 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';
1.8 minaeibi 273: $Freq=101;
1.7 minaeibi 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=';
1.10 www 333: $Ptr .= &escape('Student Assessment');
1.1 stredwic 334: $Ptr .= '&StudentAssessmentStudent=';
1.10 www 335: $Ptr .= &escape($cache->{$name.':fullname'}).'">';
1.1 stredwic 336: $Ptr .= $cache->{$name.':fullname'};
1.11 ! bisitz 337: $Ptr .= '</a>, ';
1.1 stredwic 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>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonpercentage.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface / statistics