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