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