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