Annotation of loncom/interface/statistics/lonproblemanalysis.pm, revision 1.6
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
1.6 ! stredwic 4: # $Id: lonproblemanalysis.pm,v 1.5 2002/08/13 00:37:18 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
34: # 5/12,5/14,5/15,5/19,5/26,7/16 Behrouz Minaei
35: #
36: ###
37:
38: package Apache::lonproblemanalysis;
39:
40: use strict;
41: use Apache::lonnet();
42: use GDBM_File;
43:
1.5 stredwic 44: my $jr;
1.2 stredwic 45:
1.1 stredwic 46: sub BuildProblemAnalysisPage {
1.4 stredwic 47: my ($cacheDB, $r)=@_;
1.1 stredwic 48:
49: my %cache;
1.3 stredwic 50: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
1.4 stredwic 51: $r->print('<html><body>Unable to tie database.</body></html>');
52: return;
1.1 stredwic 53: }
54:
1.4 stredwic 55: $r->print(&IntervalOptions($cache{'Interval'}));
56: $r->rflush();
57: $r->print(&OptionResponseTable($cache{'OptionResponses'}, \%cache));
1.1 stredwic 58:
59: untie(%cache);
60:
1.4 stredwic 61: return;
1.1 stredwic 62: }
63:
64: sub BuildAnalyzePage {
1.2 stredwic 65: my ($cacheDB, $students, $courseID,$r)=@_;
66:
1.5 stredwic 67: $jr = $r;
1.2 stredwic 68: my $c = $r->connection;
1.1 stredwic 69:
1.2 stredwic 70: my $Str = '</form>';
1.1 stredwic 71: my %cache;
1.5 stredwic 72: if(&Apache::loncoursedata::DownloadStudentCourseDataSeparate($students, 'true',
73: $cacheDB, 'true',
74: 'true', $courseID,
75: $r, $c) ne 'OK') {
76: $r->print($Str);
77: return;
1.2 stredwic 78: }
1.5 stredwic 79:
1.2 stredwic 80:
1.3 stredwic 81: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
1.1 stredwic 82: $Str .= '<html><body>Unable to tie database.</body></html>';
1.5 stredwic 83: $r->print($Str);
84: return;
1.1 stredwic 85: }
86:
1.2 stredwic 87: my ($problemId, $part, $responseId)=split(':',$cache{'AnalyzeInfo'});
88: my $uri = $cache{$problemId.':source'};
89: my $problem = $cache{$problemId.':problem'};
90: my $title = $cache{$problemId.':title'};
91: my $interval = $cache{'Interval'};
1.1 stredwic 92:
93: my %ConceptData;
94: $ConceptData{"Interval"} = $interval;
95:
96: #Initialize the option response true answers
1.2 stredwic 97: my ($analyzeData) = &InitAnalysis($uri, $part, $responseId, $problem,
98: $students->[0], $courseID);
99: if(defined($analyzeData->{'error'})) {
1.5 stredwic 100: $Str .= $analyzeData->{'error'}.'<br>Incorrect part requested.<br>';
101: $r->print($Str);
102: return;
1.2 stredwic 103: }
1.1 stredwic 104:
1.5 stredwic 105: $r->print($Str);
106: $Str = '';
107: if($c->aborted()) { untie(%cache); return; }
1.3 stredwic 108:
1.1 stredwic 109: #compute the intervals
1.2 stredwic 110: &Interval($part, $problem, $interval, $analyzeData->{'concepts'},
111: \%ConceptData);
1.1 stredwic 112:
113: $title =~ s/\ /"_"/eg;
114: $Str .= '<br><b>'.$uri.'</b>';
1.3 stredwic 115:
1.5 stredwic 116: $r->print($Str);
117: $Str = '';
118: if($c->aborted()) { untie(%cache); return; }
1.1 stredwic 119:
120: #Java script Progress window
1.2 stredwic 121: for(my $index=0; $index<(scalar @$students); $index++) {
1.5 stredwic 122: if($c->aborted()) { untie(%cache); return; }
123: &OpStatus($problemId, $students->[$index], \%ConceptData,
1.2 stredwic 124: $analyzeData->{'foil_to_concept'}, $analyzeData, \%cache);
1.1 stredwic 125: }
126:
127: $Str .= '<br>';
128: for (my $k=0; $k<$interval; $k++ ) {
1.3 stredwic 129: if($c->aborted()) { untie(%cache); return $Str; }
1.2 stredwic 130: $Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'},
131: \%ConceptData);
1.5 stredwic 132: $r->print($Str);
133: $Str = '';
1.1 stredwic 134: }
135: for (my $k=0; $k<$interval; $k++ ) {
1.3 stredwic 136: if($c->aborted()) { untie(%cache); return $Str; }
1.2 stredwic 137: $Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData);
1.5 stredwic 138: $r->print($Str);
139: $Str = '';
1.1 stredwic 140: }
141: my $Answ=&Apache::lonnet::ssi($uri);
142: $Str .= '<br><b>Here you can see the Problem:</b><br>'.$Answ;
1.5 stredwic 143: $Str .= '<form>';
144: $r->print($Str);
1.1 stredwic 145:
146: untie(%cache);
147:
1.5 stredwic 148: return;
1.1 stredwic 149: }
150:
151: #---- Problem Analysis Web Page ----------------------------------------------
152:
153: sub IntervalOptions {
154: my ($selectedInterval)=@_;
155:
156: my $interval = 1;
157: for(my $n=1; $n<=7; $n++) {
158: if($selectedInterval == $n) {
159: $interval = $n;
160: }
161: }
162:
163: my $Ptr = '<br><b>Select number of intervals</b>'."\n".
164: '<select name="Interval">'."\n";
165: for(my $n=1; $n<=7;$ n++) {
166: $Ptr .= '<option';
167: if($interval == $n) {
168: $Ptr .= ' selected';
169: }
170: $Ptr .= '>'.$n."</option>"."\n";
171: }
172: $Ptr .= '</select>'."\n";
173:
174: return $Ptr;
175: }
176:
177: sub OptionResponseTable {
1.2 stredwic 178: my ($optionResponses,$cache)=@_;
1.1 stredwic 179: my $Str = '';
180: $Str .= '<br><b> Option Response Problems in this course:</b>'."\n";
181: $Str .= '<br><br>'."\n";
182: $Str .= "<table border=2><tr><th> \# </th><th> Problem Title </th>";
183: $Str .= '<th> Resource </th><th> Analysis </th></tr>'."\n";
184:
185: my $number=1;
1.2 stredwic 186: my @optionResponses=split(':::', $optionResponses);
187: my %partCount;
188: foreach (@optionResponses) {
189: my ($problemId, $part, undef)=split(':',$_);
190: $partCount{$problemId.':'.$part}++;
191: }
192:
193: foreach (@optionResponses) {
194: my ($problemId, $part, $response)=split(':',$_);
195: my $uri = $cache->{$problemId.':source'};
196: my $title = $cache->{$problemId.':title'};
197:
1.1 stredwic 198: my $Temp = '<a href="'.$uri.'" target="_blank">'.$title.'</a>';
199: $Str .= '<tr>';
200: $Str .= '<td> '.$number.' </td>';
1.2 stredwic 201: $Str .= '<td bgcolor="#DDFFDD">'.$Temp.'</td>';
202: $Str .= '<td bgcolor="#EEFFCC">'.$uri.'</td>';
203: if($partCount{$problemId.':'.$part} < 2) {
204: $Str .= '<td><input type="submit" name="Analyze:::';
205: $Str .= $problemId.':'.$part.'" value="';
206: $Str .= 'Part '.$part;
207: $Str .= '" /></td></tr>'."\n";
208: } else {
209: $Str .= '<td><input type="submit" name="Analyze:::'.$_.'" value="';
210: $Str .= 'Part '.$part.' Response '.$response;
211: $Str .= '" /></td></tr>'."\n";
212: }
1.1 stredwic 213: $number++;
214: }
215: $Str .= '</table>'."\n";
216:
217: return $Str;
218: }
219:
220: #---- END Problem Analysis Web Page ------------------------------------------
221:
222: #---- Analyze Web Page -------------------------------------------------------
223:
224: #restore the student submissions and finding the result
225: sub OpStatus {
1.5 stredwic 226: my ($problemID, $student, $ConceptData, $foil_to_concept,
1.2 stredwic 227: $analyzeData, $cache)=@_;
228:
229: my $ids = $analyzeData->{'parts'};
1.1 stredwic 230: my @True = ();
231: my @False = ();
232: my $flag=0;
1.2 stredwic 233:
234: my $tries=0;
235:
1.5 stredwic 236: foreach my $id (@$ids) {
237: my ($part, $response) = split(/\./, $id);
238: my $time=$cache->{$student.':'.$problemID.':'.$part.':timestamp'};
239: my @submissions = split(':::', $cache->{$student.':'.$problemID.':'.
240: $part.':'.$response.
241: ':submission'});
242: foreach my $Resp (@submissions) {
1.2 stredwic 243: my %submission=&Apache::lonnet::str2hash($Resp);
244: foreach (keys(%submission)) {
245: if($submission{$_}) {
246: my $answer = $analyzeData->{$id.'.foil.value.'.$_};
247: if($submission{$_} eq $answer) {
248: &Decide("true", $foil_to_concept->{$_},
249: $time, $ConceptData);
250: } else {
251: &Decide("false", $foil_to_concept->{$_},
252: $time, $ConceptData);
253: }
254: }
255: }
1.1 stredwic 256: }
257: }
1.2 stredwic 258:
259: return;
1.1 stredwic 260: }
261:
262: sub DrawGraph {
263: my ($k,$Src,$Concepts,$ConceptData)=@_;
264: my $Max=0;
265: my @data1;
266: my @data2;
267:
268: # Adjust Data and find the Max
269: for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
270: my $tmp=$Concepts->[$n];
271: $data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
272: $data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
273: my $Sum=$data1[$n]+$data2[$n];
274: if($Max < $Sum) {
275: $Max=$Sum;
276: }
277: }
278: for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
279: if ($data1[$n]+$data2[$n]<$Max) {
280: $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
281: }
282: }
283: my $P_No = (scalar @data1);
284:
285: if($Max > 1) {
286: $Max += (10 - $Max % 10);
287: $Max = int($Max);
288: } else {
289: $Max = 1;
290: }
291:
292: my $Titr=($ConceptData->{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
293: # $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
294: my $GData = '';
295: $GData = $Titr.'&Concepts&Answers&'.$Max.'&'.$P_No.'&';
296: $GData .= (join(',',@data1)).'&'.(join(',',@data2));
297:
298: return '<IMG src="/cgi-bin/graph.gif?'.$GData.'" border=1/>';
299: }
300:
301: sub DrawTable {
302: my ($k,$Concepts,$ConceptData)=@_;
303: my $Max=0;
304: my @data1;
305: my @data2;
306: my $Correct=0;
307: my $Wrong=0;
308: for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
309: my $tmp=$Concepts->[$n];
310: $data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
311: $Correct+=$data1[$n];
312: $data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
313: $Wrong+=$data2[$n];
314: my $Sum=$data1[$n]+$data2[$n];
315: if($Max < $Sum) {
316: $Max=$Sum;
317: }
318: }
319: for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
320: if ($data1[$n]+$data2[$n]<$Max) {
321: $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
322: }
323: }
324: my $P_No = (scalar @data1);
325: my $Str = '';
326: # $Str .= '<br><b>From: ['.localtime($ConceptData->{'Int.'.($k-1)});
327: # $Str .= '] To: ['.localtime($ConceptData->{"Int.$k"}).']</b>';
328: $Str .= "\n".'<table border=2>'.
329: "\n".'<tr>'.
330: "\n".'<th> # </th>'.
331: "\n".'<th> Concept </th>'.
332: "\n".'<th> Correct </th>'.
333: "\n".'<th> Wrong </th>'.
334: "\n".'</tr>';
335:
336: for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
337: $Str .= '<tr>'."\n";
338: $Str .= '<td>'.($n+1).'</td>'."\n";
1.2 stredwic 339: my ($currentConcept) = split('::',$Concepts->[$n]);
340: $Str .= '<td bgcolor="EEFFCC">'.$currentConcept;
1.1 stredwic 341: $Str .= '</td>'."\n";
342: $Str .= '<td bgcolor="DDFFDD">'.$data1[$n].'</td>'."\n";
343: $Str .= '<td bgcolor="FFDDDD">'.$data2[$n].'</td>'."\n";
344: $Str .= '</tr>'."\n";
345: }
346: $Str .= '<td></td><td><b>From:['.localtime($ConceptData->{'Int.'.$k});
347: $Str .= '] To: ['.localtime($ConceptData->{'Int.'.($k+1)}-1);
348: $Str .= ']</b></td><td>'.$Correct.'</td><td>'.$Wrong.'</td>';
349: $Str .= '</table>'."\n";
350:
351: return $Str;
352: #$Apache::lonxml::debug=1;
353: #&Apache::lonhomework::showhash(%ConceptData);
354: #$Apache::lonxml::debug=0;
355: }
356:
357: #---- END Analyze Web Page ----------------------------------------------
358:
359: sub Decide {
360: #deciding the true or false answer belongs to each interval
361: my ($type,$concept,$time,$ConceptData)=@_;
362: my $k=0;
1.2 stredwic 363: while($time > $ConceptData->{'Int.'.($k+1)} &&
364: $k < $ConceptData->{'Interval'}) {
365: $k++;
366: }
1.1 stredwic 367: $ConceptData->{$concept.'.'.$k.'.'.$type}++;
368:
369: return;
370: }
371:
372: sub InitAnalysis {
1.2 stredwic 373: my ($uri,$part,$responseId,$problem,$student,$courseID)=@_;
1.1 stredwic 374: my ($name,$domain)=split(/\:/,$student);
375:
1.2 stredwic 376: my %analyzeData;
1.1 stredwic 377: # Render the student's view of the problem. $Answ is the problem
378: # Stringafied
379: my $Answ=&Apache::lonnet::ssi($uri,('grade_target' => 'analyze',
380: 'grade_username' => $name,
381: 'grade_domain' => $domain,
382: 'grade_courseid' => $courseID,
383: 'grade_symb' => $problem));
1.6 ! stredwic 384: my ($Answer)=&Apache::lonnet::str2hashref($Answ);
1.1 stredwic 385:
1.2 stredwic 386: my $found = 0;
387: my @parts=();
388: if(defined($responseId)) {
1.5 stredwic 389: foreach (@{$Answer->{'parts'}}) {
1.2 stredwic 390: if($_ eq $part.'.'.$responseId) {
391: push(@parts, $_);
392: $found = 1;
393: last;
394: }
395: }
396: } else {
1.5 stredwic 397: foreach (@{$Answer->{'parts'}}) {
1.2 stredwic 398: if($_ =~ /$part/) {
399: push(@parts, $_);
400: $found = 1;
401: last;
402: }
403: }
1.1 stredwic 404: }
405:
1.2 stredwic 406: if($found == 0) {
407: $analyzeData{'error'} = 'No parts matching selected values';
408: return \%analyzeData;
1.1 stredwic 409: }
410:
1.2 stredwic 411: my @Concepts=();
1.1 stredwic 412: my %foil_to_concept;
1.2 stredwic 413: foreach my $currentPart (@parts) {
1.5 stredwic 414: if(defined($Answer->{$currentPart.'.concepts'})) {
415: foreach my $concept (@{$Answer->{$currentPart.'.concepts'}}) {
1.2 stredwic 416: push(@Concepts, $concept);
1.5 stredwic 417: foreach my $foil (@{$Answer->{$currentPart.'.concept.'.
1.2 stredwic 418: $concept}}) {
419: $analyzeData{$currentPart.'.foil.value.'.$foil} =
1.5 stredwic 420: $Answer->{$currentPart.'.foil.value.'.$foil};
1.2 stredwic 421: $foil_to_concept{$foil} = $concept;
422: }
423: }
424: } else {
1.5 stredwic 425: foreach (keys(%$Answer)) {
1.2 stredwic 426: if(/$currentPart.foil\.value\.(.*)$/) {
427: push(@Concepts, $1);
428: $foil_to_concept{$1} = $1;
429: $analyzeData{$currentPart.'.foil.value.'.$1} =
1.5 stredwic 430: $Answer->{$currentPart.'.foil.value.'.$1};
1.2 stredwic 431: }
432: }
433: }
1.1 stredwic 434: }
435:
1.2 stredwic 436: $analyzeData{'parts'} = \@parts;
437: $analyzeData{'concepts'} = \@Concepts;
438: $analyzeData{'foil_to_concept'} = \%foil_to_concept;
439:
440: return \%analyzeData;
1.1 stredwic 441: }
442:
443: sub Interval {
444: my ($part,$symb,$interval,$Concepts,$ConceptData)=@_;
445: my $Int=$interval;
446: my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb);
447: my $opn = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb);
448: my $add=int(($due-$opn)/$Int);
449: $ConceptData->{'Int.0'}=$opn;
1.2 stredwic 450: for(my $i=1; $i<$Int; $i++) {
1.1 stredwic 451: $ConceptData->{'Int.'.$i}=$opn+$i*$add;
452: }
453: $ConceptData->{'Int.'.$Int}=$due;
1.2 stredwic 454: for(my $i=0; $i<$Int; $i++) {
455: for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
1.1 stredwic 456: my $tmp=$Concepts->[$n];
457: $ConceptData->{$tmp.'.'.$i.'.true'}=0;
458: $ConceptData->{$tmp.'.'.$i.'.false'}=0;
459: }
460: }
461: }
462: 1;
463: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonproblemanalysis.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface / statistics