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