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