1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
4: # $Id: lonproblemanalysis.pm,v 1.16 2002/11/25 18:17:36 minaeibi Exp $
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=2002
30: # 5/12,7/26,9/7,11/22 Behrouz Minaei
31: #
32: ###
33:
34: package Apache::lonproblemanalysis;
35:
36: use strict;
37: use Apache::lonnet();
38: use Apache::lonhtmlcommon();
39: use GDBM_File;
40:
41: my $jr;
42:
43: sub BuildProblemAnalysisPage {
44: my ($cacheDB, $r)=@_;
45:
46: my %cache;
47: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
48: $r->print('Unable to tie database.');
49: return;
50: }
51:
52: my $Ptr = '';
53: $Ptr .= '<table border="0"><tbody>';
54: $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
55: $Ptr .= '</td>'."\n";
56: $Ptr .= '<td align="left">'."\n";
57: my @sectionsSelected = split(':',$cache{'sectionsSelected'});
58: my @sections = split(':',$cache{'sectionList'});
59: $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
60: \@sectionsSelected,
61: 'Statistics');
62: $Ptr .= '</td></tr>'."\n";
63: $Ptr .= '<tr><td align="right"><b>Intervals</b></td>'."\n";
64: $Ptr .= '<td align="left">';
65: $Ptr .= &IntervalOptions($cache{'Interval'});
66: $Ptr .= '</td></tr></table><br>';
67: $r->print($Ptr);
68: $r->rflush();
69: $r->print(&OptionResponseTable($cache{'OptionResponses'}, \%cache, $r));
70:
71: untie(%cache);
72:
73: return;
74: }
75:
76: sub BuildAnalyzePage {
77: my ($cacheDB, $students, $courseID,$r)=@_;
78:
79: $jr = $r;
80: my $c = $r->connection;
81:
82: my $Str = '</form>';
83: my %cache;
84:
85: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
86: $Str .= 'Unable to tie database.';
87: $r->print($Str);
88: return;
89: }
90:
91: # Remove students who don't have the proper section.
92: my @sectionsSelected = split(':',$cache{'sectionsSelected'});
93:
94: my $studentCount = scalar @$students;
95: for(my $studentIndex=$studentCount-1; $studentIndex>=0;
96: $studentIndex--) {
97: my $value = $cache{$students->[$studentIndex].':section'};
98: my $found = 0;
99: foreach (@sectionsSelected) {
100: if($_ eq 'none') {
101: if($value eq '' || !defined($value) || $value eq ' ') {
102: $found = 1;
103: last;
104: }
105: } else {
106: if($value eq $_) {
107: $found = 1;
108: last;
109: }
110: }
111: }
112: if($found == 0) {
113: splice(@$students, $studentIndex, 1);
114: }
115: }
116: unless(untie(%cache)) {
117: $r->print('Can not untie hash.');
118: $r->rflush();
119: }
120:
121: &Apache::lonhtmlcommon::Close_PrgWin($r);
122:
123: ### jason code for checing is there data in cache
124: # my $error =
125: # &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
126: # 'true',
127: # $cacheDB,
128: # 'true',
129: # 'true',
130: # $courseID,
131: # $r, $c);
132: # if($error ne 'OK') {
133: # $r->print($error.'<br>Error downloading course data<br>');
134: # return;
135: # }
136:
137: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
138: $Str .= 'Unable to tie database.';
139: $r->print($Str);
140: return;
141: }
142:
143: my ($problemId, $part, $responseId)=split(':',$cache{'AnalyzeInfo'});
144: my $uri = $cache{$problemId.':source'};
145: my $problem = $cache{$problemId.':problem'};
146: my $title = $cache{$problemId.':title'};
147: my $interval = $cache{'Interval'};
148: my $heading = 'Restore this particular Option Response Problem '.
149: 'Results, Please wait...';
150:
151: my %ConceptData;
152: $ConceptData{"Interval"} = $interval;
153:
154: #Initialize the option response true answers
155: my ($analyzeData) = &InitAnalysis($uri, $part, $responseId, $problem,
156: $students->[0], $courseID);
157: if(defined($analyzeData->{'error'})) {
158: $Str .= $analyzeData->{'error'}.'<br>Incorrect part requested.<br>';
159: $r->print($Str);
160: return;
161: }
162:
163: $r->print($Str);
164: $Str = '';
165: if($c->aborted()) { untie(%cache); return; }
166:
167: #compute the intervals
168: &Interval($part, $problem, $interval, $analyzeData->{'concepts'},
169: \%ConceptData);
170:
171: $title =~ s/\ /"_"/eg;
172: $Str .= '<br><b>'.$uri.'</b>';
173:
174: $r->print($Str);
175: $Str = '';
176: if($c->aborted()) { untie(%cache); return; }
177:
178: &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
179:
180: my $count=0;
181: #Java script Progress window
182: for(my $index=0; $index<(scalar @$students); $index++) {
183: if($c->aborted()) { untie(%cache); return; }
184: $count++;
185: my $displayString = $count.'/'.$studentCount.': '.$_;
186: &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
187: &OpStatus($problemId, $students->[$index], \%ConceptData,
188: $analyzeData->{'foil_to_concept'}, $analyzeData,
189: \%cache, $courseID);
190: }
191: &Apache::lonhtmlcommon::Close_PrgWin($r);
192:
193: $Str .= '<br>';
194: for (my $k=0; $k<$interval; $k++ ) {
195: if($c->aborted()) { untie(%cache); return $Str; }
196: $Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'},
197: \%ConceptData);
198: $r->print($Str);
199: $Str = '';
200: }
201: for (my $k=0; $k<$interval; $k++ ) {
202: if($c->aborted()) { untie(%cache); return $Str; }
203: $Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData);
204: $r->print($Str);
205: $Str = '';
206: }
207: my $Answ=&Apache::lonnet::ssi($uri);
208: $Str .= '<br><b>Here you can see the Problem:</b><br>'.$Answ;
209: $Str .= '<form>';
210: $r->print($Str);
211:
212: untie(%cache);
213:
214: return;
215: }
216:
217: #---- Problem Analysis Web Page ----------------------------------------------
218:
219: sub IntervalOptions {
220: my ($selectedInterval)=@_;
221:
222: my $interval = 1;
223: for(my $n=1; $n<=7; $n++) {
224: if($selectedInterval == $n) {
225: $interval = $n;
226: }
227: }
228:
229: my $Ptr = '<select name="Interval">'."\n";
230: for(my $n=1; $n<=7;$ n++) {
231: $Ptr .= '<option';
232: if($interval == $n) {
233: $Ptr .= ' selected';
234: }
235: $Ptr .= '>'.$n."</option>"."\n";
236: }
237: $Ptr .= '</select>'."\n";
238:
239: return $Ptr;
240: }
241:
242: sub OptionResponseTable {
243: my ($optionResponses,$cache,$r)=@_;
244:
245: my @optionResponses=split(':::', $optionResponses);
246: my %partCount;
247: my %sequences;
248: my @orderedSequences=();
249: foreach(@optionResponses) {
250: my ($sequence, $problemId, $part, undef)=split(':',$_);
251: $partCount{$problemId.':'.$part}++;
252: if(!defined($sequences{$sequence})) {
253: push(@orderedSequences, $sequence);
254: $sequences{$sequence} = $_;
255: } else {
256: $sequences{$sequence} .= ':::'.$_;
257: }
258: }
259:
260: my $Str = '';
261:
262: foreach my $sequence (@orderedSequences) {
263: my @optionProblems = split(':::', $sequences{$sequence});
264:
265: $Str .= '<b>'.$cache->{$sequence.':title'}.'</b>'."\n";
266: $Str .= "<table border=2><tr><th> \# </th><th> Problem Title </th>";
267: $Str .= '<th> Resource </th><th> Analysis </th></tr>'."\n";
268:
269: my $count = 1;
270: foreach(@optionProblems) {
271: my (undef, $problemId, $part, $response)=
272: split(':',$optionProblems[$count-1]);
273: # split(':',$sequences{$sequence});
274: my $uri = $cache->{$problemId.':source'};
275: my $title = $cache->{$problemId.':title'};
276:
277: my $Temp = '<a href="'.$uri.'" target="_blank">'.$title.'</a>';
278: $Str .= '<tr>';
279: $Str .= '<td> '.$count.' </td>';
280: $Str .= '<td bgcolor="#DDFFDD">'.$Temp.'</td>';
281: $Str .= '<td bgcolor="#EEFFCC">'.$uri.'</td>';
282: if($partCount{$problemId.':'.$part} < 2) {
283: $Str .= '<td><input type="submit" name="Analyze:::';
284: $Str .= $problemId.':'.$part.'" value="';
285: $Str .= 'Part '.$part;
286: $Str .= '" /></td></tr>'."\n";
287: } else {
288: my $value = $problemId.':'.$part.':'.$response;
289: $Str .= '<td><input type="submit" name="Analyze:::'.$value;
290: $Str .= '" value="';
291: $Str .= 'Part '.$part.' Response '.$response;
292: $Str .= '" /></td></tr>'."\n";
293: }
294: $count++;
295: }
296: $Str .= '</table><br>'."\n";
297: }
298:
299: return $Str;
300: }
301:
302: #---- END Problem Analysis Web Page ------------------------------------------
303:
304: #---- Analyze Web Page -------------------------------------------------------
305:
306: # Joson code for reading data from cache
307: =pod
308: sub OpStatus {
309: my ($problemID, $student, $ConceptData, $foil_to_concept,
310: $analyzeData, $cache)=@_;
311:
312: my $ids = $analyzeData->{'parts'};
313:
314: my @True = ();
315: my @False = ();
316: my $flag=0;
317:
318: my $tries=0;
319:
320: foreach my $id (@$ids) {
321: my ($part, $response) = split(/\./, $id);
322: my $time=$cache->{$student.':'.$problemID.':'.$part.':timestamp'};
323: my @submissions = split(':::', $cache->{$student.':'.$problemID.':'.
324: $part.':'.$response.
325: ':submission'});
326: foreach my $Resp (@submissions) {
327: my %submission=&Apache::lonnet::str2hash($Resp);
328: foreach (keys(%submission)) {
329: if($submission{$_}) {
330: my $answer = $analyzeData->{$id.'.foil.value.'.$_};
331: if($submission{$_} eq $answer) {
332: &Decide("true", $foil_to_concept->{$_},
333: $time, $ConceptData);
334: } else {
335: &Decide("false", $foil_to_concept->{$_},
336: $time, $ConceptData);
337: }
338: }
339: }
340: }
341: }
342:
343: return;
344: }
345: =cut
346:
347:
348: #restore the student submissions and finding the result
349:
350: sub OpStatus {
351: my ($problemID, $student, $ConceptData, $foil_to_concept,
352: $analyzeData, $cache, $courseID)=@_;
353:
354: my $ids = $analyzeData->{'parts'};
355: my ($uname,$udom)=split(/\:/,$student);
356: my $symb = $cache->{$problemID.':problem'};
357:
358: my @True = ();
359: my @False = ();
360: my $flag=0;
361: my $tries=0;
362:
363: foreach my $id (@$ids) {
364: my ($part, $response) = split(/\./, $id);
365: my %reshash=&Apache::lonnet::restore($symb,$courseID,$udom,$uname);
366: if ($reshash{'version'}) {
367: my $tries=0;
368: for (my $version=1;$version<=$reshash{'version'};$version++) {
369: my $time=$reshash{"$version:timestamp"};
370: foreach my $key (sort(split(/\:/,$reshash{$version.':keys'}))) {
371: if (($key=~/\.(\w+)\.(\w+)\.submission$/)) {
372: my $Id1 = $1; my $Id2 = $2;
373: #check if this is a repeat submission, if so skip it
374: if ($reshash{"$version:resource.$Id1.previous"}) { next; }
375: #if no solved this wasn't a real submission, ignore it
376: if (!defined($reshash{"$version:resource.$Id1.solved"})) {
377: &Apache::lonxml::debug("skipping ");
378: next;
379: }
380: my $Resp = $reshash{"$version:$key"};
381: my %submission=&Apache::lonnet::str2hash($Resp);
382: foreach (keys %submission) {
383: my $Ansr = $analyzeData->{"$Id1.$Id2.foil.value.$_"};
384: if($submission{$_} eq $Ansr) {
385: &Decide("true", $foil_to_concept->{$_},
386: $time, $ConceptData);
387: } else {
388: &Decide("false", $foil_to_concept->{$_},
389: $time, $ConceptData);
390: }
391: }
392: }
393: }
394: }
395: }
396: }
397:
398: return;
399: }
400:
401:
402: sub DrawGraph {
403: my ($k,$Src,$Concepts,$ConceptData)=@_;
404: my $Max=0;
405: my @data1;
406: my @data2;
407:
408: # Adjust Data and find the Max
409: for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
410: my $tmp=$Concepts->[$n];
411: $data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
412: $data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
413: my $Sum=$data1[$n]+$data2[$n];
414: if($Max < $Sum) {
415: $Max=$Sum;
416: }
417: }
418: for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
419: if ($data1[$n]+$data2[$n]<$Max) {
420: $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
421: }
422: }
423: my $P_No = (scalar @data1);
424:
425: if($Max > 1) {
426: $Max += (10 - $Max % 10);
427: $Max = int($Max);
428: } else {
429: $Max = 1;
430: }
431:
432: my $Titr=($ConceptData->{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
433: # $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
434: my $GData = '';
435: $GData = $Titr.'&Concepts&Answers&'.$Max.'&'.$P_No.'&';
436: $GData .= (join(',',@data1)).'&'.(join(',',@data2));
437:
438: return '<IMG src="/cgi-bin/graph.gif?'.$GData.'" border=1/>';
439: }
440:
441: sub DrawTable {
442: my ($k,$Concepts,$ConceptData)=@_;
443: my $Max=0;
444: my @data1;
445: my @data2;
446: my $Correct=0;
447: my $Wrong=0;
448: for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
449: my $tmp=$Concepts->[$n];
450: $data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
451: $Correct+=$data1[$n];
452: $data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
453: $Wrong+=$data2[$n];
454: my $Sum=$data1[$n]+$data2[$n];
455: if($Max < $Sum) {
456: $Max=$Sum;
457: }
458: }
459: for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
460: if ($data1[$n]+$data2[$n]<$Max) {
461: $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
462: }
463: }
464: my $P_No = (scalar @data1);
465: my $Str = '';
466: # $Str .= '<br><b>From: ['.localtime($ConceptData->{'Int.'.($k-1)});
467: # $Str .= '] To: ['.localtime($ConceptData->{"Int.$k"}).']</b>';
468: $Str .= "\n".'<table border=2>'.
469: "\n".'<tr>'.
470: "\n".'<th> # </th>'.
471: "\n".'<th> Concept </th>'.
472: "\n".'<th> Correct </th>'.
473: "\n".'<th> Wrong </th>'.
474: "\n".'</tr>';
475:
476: for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
477: $Str .= '<tr>'."\n";
478: $Str .= '<td>'.($n+1).'</td>'."\n";
479: my ($currentConcept) = split('::',$Concepts->[$n]);
480: $Str .= '<td bgcolor="EEFFCC">'.$currentConcept;
481: $Str .= '</td>'."\n";
482: $Str .= '<td bgcolor="DDFFDD">'.$data1[$n].'</td>'."\n";
483: $Str .= '<td bgcolor="FFDDDD">'.$data2[$n].'</td>'."\n";
484: $Str .= '</tr>'."\n";
485: }
486: $Str .= '<td></td><td><b>From:['.localtime($ConceptData->{'Int.'.$k});
487: $Str .= '] To: ['.localtime($ConceptData->{'Int.'.($k+1)}-1);
488: $Str .= ']</b></td><td>'.$Correct.'</td><td>'.$Wrong.'</td>';
489: $Str .= '</table>'."\n";
490:
491: return $Str;
492: #$Apache::lonxml::debug=1;
493: #&Apache::lonhomework::showhash(%ConceptData);
494: #$Apache::lonxml::debug=0;
495: }
496:
497: #---- END Analyze Web Page ----------------------------------------------
498:
499: sub Decide {
500: #deciding the true or false answer belongs to each interval
501: my ($type,$concept,$time,$ConceptData)=@_;
502: my $k=0;
503: while($time > $ConceptData->{'Int.'.($k+1)} &&
504: $k < $ConceptData->{'Interval'}) {
505: $k++;
506: }
507: $ConceptData->{$concept.'.'.$k.'.'.$type}++;
508:
509: return;
510: }
511:
512: sub InitAnalysis {
513: my ($uri,$part,$responseId,$problem,$student,$courseID)=@_;
514: my ($name,$domain)=split(/\:/,$student);
515:
516: my %analyzeData;
517: # Render the student's view of the problem. $Answ is the problem
518: # Stringafied
519: my $Answ=&Apache::lonnet::ssi($uri,('grade_target' => 'analyze',
520: 'grade_username' => $name,
521: 'grade_domain' => $domain,
522: 'grade_courseid' => $courseID,
523: 'grade_symb' => $problem));
524: my ($Answer)=&Apache::lonnet::str2hashref($Answ);
525:
526: my $found = 0;
527: my @parts=();
528: if(defined($responseId)) {
529: foreach (@{$Answer->{'parts'}}) {
530: if($_ eq $part.'.'.$responseId) {
531: push(@parts, $_);
532: $found = 1;
533: last;
534: }
535: }
536: } else {
537: foreach (@{$Answer->{'parts'}}) {
538: if($_ =~ /$part/) {
539: push(@parts, $_);
540: $found = 1;
541: last;
542: }
543: }
544: }
545:
546: if($found == 0) {
547: $analyzeData{'error'} = 'No parts matching selected values';
548: return \%analyzeData;
549: }
550:
551: my @Concepts=();
552: my %foil_to_concept;
553: foreach my $currentPart (@parts) {
554: if(defined($Answer->{$currentPart.'.concepts'})) {
555: foreach my $concept (@{$Answer->{$currentPart.'.concepts'}}) {
556: push(@Concepts, $concept);
557: foreach my $foil (@{$Answer->{$currentPart.'.concept.'.
558: $concept}}) {
559: $analyzeData{$currentPart.'.foil.value.'.$foil} =
560: $Answer->{$currentPart.'.foil.value.'.$foil};
561: $foil_to_concept{$foil} = $concept;
562: }
563: }
564: } else {
565: foreach (keys(%$Answer)) {
566: if(/$currentPart.foil\.value\.(.*)$/) {
567: push(@Concepts, $1);
568: $foil_to_concept{$1} = $1;
569: $analyzeData{$currentPart.'.foil.value.'.$1} =
570: $Answer->{$currentPart.'.foil.value.'.$1};
571: }
572: }
573: }
574: }
575:
576: $analyzeData{'parts'} = \@parts;
577: $analyzeData{'concepts'} = \@Concepts;
578: $analyzeData{'foil_to_concept'} = \%foil_to_concept;
579:
580: return \%analyzeData;
581: }
582:
583: sub Interval {
584: my ($part,$symb,$interval,$Concepts,$ConceptData)=@_;
585: my $Int=$interval;
586: my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb);
587: my $opn = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb);
588: my $add=int(($due-$opn)/$Int);
589: $ConceptData->{'Int.0'}=$opn;
590: for(my $i=1; $i<$Int; $i++) {
591: $ConceptData->{'Int.'.$i}=$opn+$i*$add;
592: }
593: $ConceptData->{'Int.'.$Int}=$due;
594: for(my $i=0; $i<$Int; $i++) {
595: for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
596: my $tmp=$Concepts->[$n];
597: $ConceptData->{$tmp.'.'.$i.'.true'}=0;
598: $ConceptData->{$tmp.'.'.$i.'.false'}=0;
599: }
600: }
601: }
602: 1;
603: __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