Annotation of loncom/interface/statistics/lonproblemanalysis.pm, revision 1.27
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: #
1.27 ! matthew 3: # $Id: lonproblemanalysis.pm,v 1.26 2003/10/07 16:07:39 matthew Exp $
1.1 stredwic 4: #
5: # Copyright Michigan State University Board of Trustees
6: #
7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
8: #
9: # LON-CAPA is free software; you can redistribute it and/or modify
10: # it under the terms of the GNU General Public License as published by
11: # the Free Software Foundation; either version 2 of the License, or
12: # (at your option) any later version.
13: #
14: # LON-CAPA is distributed in the hope that it will be useful,
15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17: # GNU General Public License for more details.
18: #
19: # You should have received a copy of the GNU General Public License
20: # along with LON-CAPA; if not, write to the Free Software
21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22: #
23: # /home/httpd/html/adm/gpl.txt
24: #
25: # http://www.lon-capa.org/
26: #
27:
1.11 minaeibi 28: package Apache::lonproblemanalysis;
1.1 stredwic 29:
30: use strict;
31: use Apache::lonnet();
1.25 matthew 32: use Apache::loncommon();
1.7 stredwic 33: use Apache::lonhtmlcommon();
1.23 matthew 34: use Apache::loncoursedata();
35: use Apache::lonstatistics;
36: use Apache::lonlocal;
1.2 stredwic 37:
1.1 stredwic 38: sub BuildProblemAnalysisPage {
1.23 matthew 39: my ($r,$c)=@_;
1.24 matthew 40: $r->print('<h2>'.&mt('Option Response Problem Analysis').'</h2>');
1.25 matthew 41: $r->print(&CreateInterface());
1.23 matthew 42: if (exists($ENV{'form.problemchoice'})) {
1.25 matthew 43: $r->print('<hr />');
44: &Apache::lonstatistics::Gather_Full_Student_Data($r);
1.23 matthew 45: #
1.25 matthew 46: my ($symb,$part,$resid) = &get_problem_symb(
1.23 matthew 47: &Apache::lonnet::unescape($ENV{'form.problemchoice'})
48: );
49: my $resource = &get_resource_from_symb($symb);
50: if (defined($resource)) {
1.25 matthew 51: my %Data = &get_problem_data($resource->{'src'});
52: my $ORdata = $Data{$part.'.'.$resid};
53: ##
1.26 matthew 54: ## Render the problem
1.25 matthew 55: my $base;
56: ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
57: $base = "http://".$ENV{'SERVER_NAME'}.$base;
1.26 matthew 58: my $rendered_problem =
59: &Apache::lonnet::ssi_body($resource->{'src'});
60: $rendered_problem =~ s/<form /<nop /g;
61: $rendered_problem =~ s/<\s*\/form\s>/<\/nop>/g;
62: $r->print('<table bgcolor="ffffff"><tr><td>'.
1.25 matthew 63: '<base href="'.$base.'" />'.
1.26 matthew 64: $rendered_problem.
65: '</td></tr></table>');
1.25 matthew 66: ##
67: ## Analyze the problem
1.26 matthew 68: my $PerformanceData =
69: &Apache::loncoursedata::get_optionresponse_data
70: (undef,$symb,$resid);
71: if (defined($PerformanceData) &&
72: ref($PerformanceData) eq 'ARRAY') {
73: my $analysis_html = &DoTriesAnalysis($PerformanceData,$ORdata);
74: $r->print($analysis_html);
75: } else {
76: $r->print('<h2>'.
77: &mt('There is no student data for this problem.').
78: '</h2>');
79: }
1.23 matthew 80: } else {
81: $r->print('resource is undefined');
1.7 stredwic 82: }
1.23 matthew 83: $r->print('<hr />');
1.25 matthew 84: } else {
1.27 ! matthew 85: $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
1.1 stredwic 86: }
1.23 matthew 87: # Okay, they asked for data, so make sure we get the latest data.
88: $r->print(&OptionResponseProblemSelector());
1.1 stredwic 89: }
90:
1.25 matthew 91:
92: sub DoTriesAnalysis {
1.26 matthew 93: my ($PerformanceData,$ORdata) = @_;
1.25 matthew 94: my $mintries = 1;
95: my $maxtries = 3;
1.26 matthew 96: my %ResponseData = &analyze_option_data_by_tries($PerformanceData,
1.25 matthew 97: $mintries,$maxtries);
98: my @Foils = sort(keys(%ResponseData));
99: my %Row_Label;
100: foreach my $foilid (@Foils) {
101: my $value = $ORdata->{'Foiltext'}->{$foilid};
1.26 matthew 102: # &Apache::lonnet::logthis('row label '.$foilid.' = '.$value);
1.25 matthew 103: $Row_Label{$foilid} = $ORdata->{'Foiltext'}->{$foilid};
104: }
105: my @Rows;
106: $Rows[0] = ['<td> </td>'];
107: for (my $i=$mintries;$i<=$maxtries;$i++) {
108: push (@{$Rows[0]},
109: '<th colspan="3">'.&mt('Attempt').' '.$i.'</th>');
110: }
111: $Rows[1] = ['<th>'.&mt('Foil').'</th>'];
112: for (my $i=$mintries;$i<=$maxtries;$i++) {
113: push (@{$Rows[1]},('<th>'.&mt('Correct').'</th>',
114: '<th>'.&mt('Incorrect').'</th>',
115: '<th>'.&mt('Percent Correct').'</th>',
116: ));
117: }
118: my @PlotData;
119: my @CumulativePlotData;
120: my $index = 1;
121: foreach my $foilid (@Foils) {
122: my @Data = ('<td>'.$index.' '.$Row_Label{$foilid}.'</td>');
123: for (my $i=$mintries;$i<=$maxtries;$i++) {
124: push(@Data,
125: ('<td>'.$ResponseData{$foilid}->[$i]->{'correct'}.'</td>',
126: '<td>'.$ResponseData{$foilid}->[$i]->{'incorrect'}.
127: '</td>',
128: '<td>'.
129: sprintf("%4.2f",
130: $ResponseData{$foilid}->[$i]->{'percent_corr'}).
131: '</td>'));
132: #
133: # Gather the per-attempt data
134: push (@{$PlotData[$i]->{'good'}},
135: $ResponseData{$foilid}->[$i]->{'percent_corr'});
136: push (@{$PlotData[$i]->{'bad'}},
137: 100-$ResponseData{$foilid}->[$i]->{'percent_corr'});
138: }
139: for (my $i=0;$i<=$maxtries;$i++) {
140: push (@{$CumulativePlotData[$i]->{'good'}},
141: $CumulativePlotData[-1]->{'good'}+
142: $ResponseData{$foilid}->[$i]->{'correct'});
143: push (@{$CumulativePlotData[$i]->{'bad'}},
144: $CumulativePlotData[-1]->{'bad'}+
145: $ResponseData{$foilid}->[$i]->{'incorrect'});
146: }
147: push(@Rows,\@Data);
148: } continue {
149: $index++;
150: }
151: my @Data = ('<td></td>');
152: for (my $i=$mintries;$i<=$maxtries;$i++) {
1.27 ! matthew 153: my $minstu = $ResponseData{$Foils[0]}->[$i]->{'total'};
! 154: my $maxstu = $ResponseData{$Foils[0]}->[$i]->{'total'};
! 155: foreach my $foilid (@Foils) {
! 156: if ($minstu > $ResponseData{$foilid}->[$i]->{'total'}) {
! 157: $minstu = $ResponseData{$foilid}->[$i]->{'total'};
! 158: }
! 159: if ($maxstu < $ResponseData{$foilid}->[$i]->{'total'}) {
! 160: $maxstu = $ResponseData{$foilid}->[$i]->{'total'};
! 161: }
! 162: }
! 163: my $graphlink;
! 164: if ($maxstu == $minstu) {
! 165: $graphlink = &DrawGraph('Attempt '.$i.', '.$maxstu.' students',
! 166: 'Foil Number',
! 167: 'Percent Correct',
! 168: 100,
! 169: $PlotData[$i]->{'good'},
! 170: $PlotData[$i]->{'bad'});
! 171: } else {
! 172: $graphlink = &DrawGraph('Attempt '.$i.', '.$minstu.'-'.$maxstu.
! 173: ' students',
! 174: 'Foil Number',
! 175: 'Percent Correct',
! 176: 100,
! 177: $PlotData[$i]->{'good'},
! 178: $PlotData[$i]->{'bad'});
! 179: }
! 180: push(@Data,'<td colspan="3">'.$graphlink.'</td>');
1.25 matthew 181: }
182: push (@Rows,\@Data);
183: my $table = '<table border="1" >'."\n";
184: for (my $i=0; $i <=$#Rows;$i++) {
185: $table .= '<tr>'.join('',@{$Rows[$i]})."</tr>\n";
186: }
187: $table .= '</table>';
188: return ($table);
189: }
190:
191: sub analyze_option_data_by_tries {
1.26 matthew 192: my ($PerformanceData,$mintries,$maxtries) = @_;
1.25 matthew 193: my %Trydata;
194: $mintries = 1 if (! defined($mintries) || $mintries < 1);
195: $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
1.26 matthew 196: foreach my $row (@$PerformanceData) {
197: next if (! defined($row));
1.25 matthew 198: my ($grading,$submission,$time,$tries) = @$row;
199: my @Foilgrades = split('&',$grading);
200: my @Foilsubs = split('&',$submission);
201: for (my $numtries = 1; $numtries <= $maxtries; $numtries++) {
202: if ($tries == $numtries) {
203: foreach my $foilgrade (@Foilgrades) {
204: my ($foilid,$correct) = split('=',$foilgrade);
205: if ($correct) {
206: $Trydata{$foilid}->[$numtries]->{'correct'}++;
207: } else {
208: $Trydata{$foilid}->[$numtries]->{'incorrect'}++;
209: }
210: }
211: }
212: }
213: }
214: foreach my $foilid (keys(%Trydata)) {
215: foreach my $tryhash (@{$Trydata{$foilid}}) {
216: next if ((! exists($tryhash->{'correct'}) &&
217: ! exists($tryhash->{'incorrect'})) ||
218: ($tryhash->{'correct'} < 1 &&
219: $tryhash->{'incorrect'} < 1));
1.27 ! matthew 220: $tryhash->{'total'} = $tryhash->{'correct'} +
! 221: $tryhash->{'incorrect'};
1.25 matthew 222: $tryhash->{'percent_corr'} = 100 *
223: ($tryhash->{'correct'} /
224: ($tryhash->{'correct'} + $tryhash->{'incorrect'})
225: );
226: }
227: }
228: return %Trydata;
229: }
230:
231: sub DrawGraph {
232: my ($title,$xlabel,$ylabel,$MaxY,$values1,$values2)=@_;
1.26 matthew 233: if (! defined($values1) || ref($values1) ne 'ARRAY') {
234: return '';
235: }
1.25 matthew 236: $title = '' if (! defined($title));
237: $xlabel = '' if (! defined($xlabel));
238: $ylabel = '' if (! defined($ylabel));
239: $title = &Apache::lonnet::escape($title);
240: $xlabel = &Apache::lonnet::escape($xlabel);
241: $ylabel = &Apache::lonnet::escape($ylabel);
242: #
243: my $sendValues1 = join(',', @$values1);
244: my $sendValues2;
245: if (defined($values2)) {
246: $sendValues2 = join(',', @$values2);
247: }
248:
249: my $sendCount = scalar(@$values1);
250: $MaxY =1 if ($MaxY < 1);
251: if ( int($MaxY) < $MaxY ) {
252: $MaxY++;
253: $MaxY = int($MaxY);
254: }
255: my @GData = ($title,$xlabel,$ylabel,$MaxY,$sendCount,$sendValues1);
256: if (defined($sendValues2)) {
257: push (@GData,$sendValues2);
258: }
259: return '<IMG src="/cgi-bin/graph.png?'.
260: (join('&', @GData)).'" border="1" />';
261: }
262:
263:
264:
1.23 matthew 265: sub get_problem_symb {
266: my $problemstring = shift();
1.25 matthew 267: my ($symb,$partid,$resid) = ($problemstring=~ /^(.*):([^:]*):([^:]*)$/);
268: return ($symb,$partid,$resid);
1.1 stredwic 269: }
270:
1.23 matthew 271: sub CreateInterface {
1.7 stredwic 272: my $Str = '';
1.23 matthew 273: $Str .= '<table cellspacing="5">'."\n";
274: $Str .= '<tr>';
275: $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
276: $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
277: $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
278: $Str .= '</tr>'."\n";
279: #
280: $Str .= '<tr><td align="center">'."\n";
281: $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
282: $Str .= '</td><td align="center">';
283: $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
284: $Str .= '</td><td align="center">';
285: my $only_seq_with_assessments = sub {
286: my $s=shift;
287: if ($s->{'num_assess'} < 1) {
288: return 0;
289: } else {
290: return 1;
291: }
292: };
293: $Str .= &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
294: $only_seq_with_assessments);
295: $Str .= '</td></tr>'."\n";
296: $Str .= '</table>'."\n";
297: $Str .= '<input type="submit" name="ProblemAnalysis" value="'.
298: &mt('Analyze Problem').'" />';
299: $Str .= ' 'x5;
300: $Str .= '<input type="submit" name="ClearCache" value="'.
301: &mt('Clear Caches').'" />';
302: $Str .= ' 'x5;
303: return ($Str);
304: }
305:
306: sub OptionResponseProblemSelector {
307: my $Str;
308: $Str = "\n<table>\n";
309: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
310: next if ($seq->{'num_assess'}<1);
311: my $seq_str = '';
312: foreach my $res (@{$seq->{'contents'}}) {
313: # &Apache::lonnet::logthis('checking '.$res->{'title'});
1.26 matthew 314: next if ($res->{'type'} ne 'assessment');
1.23 matthew 315: foreach my $part (@{$res->{'parts'}}) {
316: my $partdata = $res->{'partdata'}->{$part};
317: if (! exists($partdata->{'option'}) ||
318: $partdata->{'option'} == 0) {
319: next;
320: }
321: for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
322: my $respid = $partdata->{'ResponseIds'}->[$i];
323: my $resptype = $partdata->{'ResponseTypes'}->[$i];
324: if ($resptype eq 'option') {
1.25 matthew 325: my $value = &Apache::lonnet::escape($res->{'symb'}.':'.$part.':'.$respid);
1.23 matthew 326: my $checked = '';
327: if ($ENV{'form.problemchoice'} eq $value) {
328: $checked = 'checked ';
329: }
330: $seq_str .= '<tr><td>'.
331: '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
332: '</td><td>'.
333: '<a href="'.$res->{'src'}.'">'.$res->{'title'}.'</a> ';
334: if ($partdata->{'option'} > 1) {
335: $seq_str .= &mt('response').' '.$respid;
336: }
337: $seq_str .= "</td></tr>\n";
1.11 minaeibi 338: }
339: }
340: }
341: }
1.23 matthew 342: if ($seq_str ne '') {
343: $Str .= '<tr><td> </td><td><b>'.$seq->{'title'}.'</b></td>'.
344: "</tr>\n".$seq_str;
345: }
1.11 minaeibi 346: }
1.23 matthew 347: $Str .= "</table>\n";
348: return $Str;
1.11 minaeibi 349: }
350:
1.23 matthew 351: sub get_resource_from_symb {
352: my ($symb) = @_;
353: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
354: foreach my $res (@{$seq->{'contents'}}) {
355: if ($res->{'symb'} eq $symb) {
356: return $res;
1.2 stredwic 357: }
1.1 stredwic 358: }
359: }
1.23 matthew 360: return undef;
1.1 stredwic 361: }
362:
1.25 matthew 363: sub get_problem_data {
364: my ($url) = @_;
365: # my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze',
366: # 'grade_username' => $sname,
367: # 'grade_domain' => $sdom,
368: # 'grade_courseid' => $cid,
369: # 'grade_symb' => $symb));
370: my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
1.23 matthew 371: (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
1.25 matthew 372: my %Answer;
1.23 matthew 373: %Answer=&Apache::lonnet::str2hash($Answ);
1.25 matthew 374: # &Apache::lonnet::logthis('keys of %Answer = '.join(', ',(keys(%Answer))));
375: # &Apache::lonnet::logthis('$Answer{parts} = '.
376: # join(', ',@{$Answer{'parts'}}));
377: my %Partdata;
378: foreach my $part (@{$Answer{'parts'}}) {
379: while (my($key,$value) = each(%Answer)) {
380: next if ($key !~ /^$part/);
381: $key =~ s/^$part\.//;
382: if (ref($value) eq 'ARRAY') {
383: if ($key eq 'options') {
384: $Partdata{$part}->{'Options'}=$value;
385: } elsif ($key eq 'concepts') {
386: $Partdata{$part}->{'Concepts'}=$value;
387: } elsif ($key =~ /^concept\.(.*)$/) {
388: my $concept = $1;
389: foreach my $foil (@$value) {
390: $Partdata{$part}->{$foil}->{'Concept'}=$concept;
391: }
392: }
1.26 matthew 393: # &Apache::lonnet::logthis($part.' '.$key.' (array) = '.
394: # join(', ',@$value));
1.25 matthew 395: } else {
396: $value =~ s/^\s*//g;
397: $value =~ s/\s*$//g;
398: if ($key=~ /^foil\.text\.(.*)$/) {
399: my $foil = $1;
400: $Partdata{$part}->{'Foiltext'}->{$foil}=$value;
401: } elsif ($key =~ /^foil\.value\.(.*)$/) {
402: my $foil = $1;
403: $Partdata{$part}->{'FoilValues'}->{$foil}=$value;
404: }
1.26 matthew 405: # &Apache::lonnet::logthis($part.' '.$key.' = '.$value);
1.25 matthew 406: }
407: }
1.23 matthew 408: }
409:
1.25 matthew 410: # my $parts='';
411: # foreach my $elm (@{$Answer{"parts"}}) {
412: # $parts.="$elm,";
413: # }
414: # chop($parts);
415: # my $conc='';
416: # foreach my $elm (@{$Answer{"$parts.concepts"}}) {
417: # $conc.="$elm@";
418: # }
419: # chop($conc);
420: #
421: # @Concepts=split(/\@/,$conc);
422: # foreach my $concept (@{$Answer{"$parts.concepts"}}) {
423: # foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
424: # $foil_to_concept{$foil} = $concept;
425: # #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
426: # }
427: # }
428: # return $symb;
429: return %Partdata;
1.1 stredwic 430: }
431:
1.23 matthew 432: 1;
1.1 stredwic 433:
434: __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