1: # The LearningOnline Network with CAPA
2: #
3: # $Id: lonproblemanalysis.pm,v 1.25 2003/10/06 20:51:20 matthew Exp $
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:
28: package Apache::lonproblemanalysis;
29:
30: use strict;
31: use Apache::lonnet();
32: use Apache::loncommon();
33: use Apache::lonhtmlcommon();
34: use Apache::loncoursedata();
35: use Apache::lonstatistics;
36: use Apache::lonlocal;
37:
38: sub BuildProblemAnalysisPage {
39: my ($r,$c)=@_;
40: $r->print('<h2>'.&mt('Option Response Problem Analysis').'</h2>');
41: $r->print(&CreateInterface());
42: if (exists($ENV{'form.problemchoice'})) {
43: $r->print('<hr />');
44: &Apache::lonstatistics::Gather_Full_Student_Data($r);
45: #
46: my ($symb,$part,$resid) = &get_problem_symb(
47: &Apache::lonnet::unescape($ENV{'form.problemchoice'})
48: );
49: $r->print('<hr />');
50: my $resource = &get_resource_from_symb($symb);
51: if (defined($resource)) {
52: my %Data = &get_problem_data($resource->{'src'});
53: my $ORdata = $Data{$part.'.'.$resid};
54: ##
55: ## Render the problem for display
56: my $base;
57: ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
58: $base = "http://".$ENV{'SERVER_NAME'}.$base;
59: $r->print('</form>'.
60: '<table bgcolor="ffffff"><tr><td>'.
61: '<base href="'.$base.'" />'.
62: # &Apache::loncommon::get_student_view
63: # ($symb,$ENV{'user.name'},$ENV{'user.domain'},$ENV{'request.course.id'},'web').
64: &Apache::lonnet::ssi_body($resource->{'src'}).
65: '</td></tr></table>'.
66: '<form name="Statistics" method="post" action="/adm/statistics">');
67: ##
68: ## Analyze the problem
69: my @Data = &Apache::loncoursedata::get_optionresponse_data
70: (undef,$symb,$resid);
71: my $analysis_html = &DoTriesAnalysis(\@Data,$ORdata);
72: $r->print($analysis_html);
73: } else {
74: $r->print('resource is undefined');
75: }
76: $r->print('<ol>');
77: $r->print("<li /><strike>render problem</strike>\n");
78: $r->print("<li /><strike>Get student response data</strike>\n");
79: $r->print("<li />image tag for plot\n");
80: $r->print("<li />plot key\n");
81: $r->print('</ol>');
82: $r->print('<hr />');
83: } else {
84: $r->print('<h3>No Problem Selected</h3>');
85: }
86: # Okay, they asked for data, so make sure we get the latest data.
87: $r->print(&OptionResponseProblemSelector());
88: }
89:
90:
91: sub DoTriesAnalysis {
92: my ($Data,$ORdata) = @_;
93: my $mintries = 1;
94: my $maxtries = 3;
95: my %ResponseData = &analyze_option_data_by_tries($Data,
96: $mintries,$maxtries);
97: my @Foils = sort(keys(%ResponseData));
98: my %Row_Label;
99: foreach my $foilid (@Foils) {
100: my $value = $ORdata->{'Foiltext'}->{$foilid};
101: &Apache::lonnet::logthis('row label '.$foilid.' = '.$value);
102: $Row_Label{$foilid} = $ORdata->{'Foiltext'}->{$foilid};
103: }
104: my @Rows;
105: $Rows[0] = ['<td> </td>'];
106: for (my $i=$mintries;$i<=$maxtries;$i++) {
107: push (@{$Rows[0]},
108: '<th colspan="3">'.&mt('Attempt').' '.$i.'</th>');
109: }
110: $Rows[1] = ['<th>'.&mt('Foil').'</th>'];
111: for (my $i=$mintries;$i<=$maxtries;$i++) {
112: push (@{$Rows[1]},('<th>'.&mt('Correct').'</th>',
113: '<th>'.&mt('Incorrect').'</th>',
114: '<th>'.&mt('Percent Correct').'</th>',
115: ));
116: }
117: my @PlotData;
118: my @CumulativePlotData;
119: my $index = 1;
120: foreach my $foilid (@Foils) {
121: my @Data = ('<td>'.$index.' '.$Row_Label{$foilid}.'</td>');
122: for (my $i=$mintries;$i<=$maxtries;$i++) {
123: push(@Data,
124: ('<td>'.$ResponseData{$foilid}->[$i]->{'correct'}.'</td>',
125: '<td>'.$ResponseData{$foilid}->[$i]->{'incorrect'}.
126: '</td>',
127: '<td>'.
128: sprintf("%4.2f",
129: $ResponseData{$foilid}->[$i]->{'percent_corr'}).
130: '</td>'));
131: #
132: # Gather the per-attempt data
133: push (@{$PlotData[$i]->{'good'}},
134: $ResponseData{$foilid}->[$i]->{'percent_corr'});
135: push (@{$PlotData[$i]->{'bad'}},
136: 100-$ResponseData{$foilid}->[$i]->{'percent_corr'});
137: }
138: for (my $i=0;$i<=$maxtries;$i++) {
139: push (@{$CumulativePlotData[$i]->{'good'}},
140: $CumulativePlotData[-1]->{'good'}+
141: $ResponseData{$foilid}->[$i]->{'correct'});
142: push (@{$CumulativePlotData[$i]->{'bad'}},
143: $CumulativePlotData[-1]->{'bad'}+
144: $ResponseData{$foilid}->[$i]->{'incorrect'});
145: }
146: push(@Rows,\@Data);
147: } continue {
148: $index++;
149: }
150: my @Data = ('<td></td>');
151: for (my $i=$mintries;$i<=$maxtries;$i++) {
152: push(@Data,'<td colspan="3">'.&DrawGraph('Attempt '.$i,'Foil Number',
153: 'Percent Correct',100,
154: $PlotData[$i]->{'good'},
155: $PlotData[$i]->{'bad'}).'</td>');
156: }
157: push (@Rows,\@Data);
158: my $table = '<table border="1" >'."\n";
159: for (my $i=0; $i <=$#Rows;$i++) {
160: $table .= '<tr>'.join('',@{$Rows[$i]})."</tr>\n";
161: }
162: $table .= '</table>';
163: return ($table);
164: }
165:
166: sub analyze_option_data_by_tries {
167: my ($data,$mintries,$maxtries) = @_;
168: my %Trydata;
169: $mintries = 1 if (! defined($mintries) || $mintries < 1);
170: $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
171: foreach my $row (@$data) {
172: my ($grading,$submission,$time,$tries) = @$row;
173: my @Foilgrades = split('&',$grading);
174: my @Foilsubs = split('&',$submission);
175: for (my $numtries = 1; $numtries <= $maxtries; $numtries++) {
176: if ($tries == $numtries) {
177: foreach my $foilgrade (@Foilgrades) {
178: my ($foilid,$correct) = split('=',$foilgrade);
179: if ($correct) {
180: $Trydata{$foilid}->[$numtries]->{'correct'}++;
181: } else {
182: $Trydata{$foilid}->[$numtries]->{'incorrect'}++;
183: }
184: }
185: }
186: }
187: }
188: foreach my $foilid (keys(%Trydata)) {
189: foreach my $tryhash (@{$Trydata{$foilid}}) {
190: next if ((! exists($tryhash->{'correct'}) &&
191: ! exists($tryhash->{'incorrect'})) ||
192: ($tryhash->{'correct'} < 1 &&
193: $tryhash->{'incorrect'} < 1));
194: $tryhash->{'percent_corr'} = 100 *
195: ($tryhash->{'correct'} /
196: ($tryhash->{'correct'} + $tryhash->{'incorrect'})
197: );
198: }
199: }
200: return %Trydata;
201: }
202:
203: sub DrawGraph {
204: my ($title,$xlabel,$ylabel,$MaxY,$values1,$values2)=@_;
205: $title = '' if (! defined($title));
206: $xlabel = '' if (! defined($xlabel));
207: $ylabel = '' if (! defined($ylabel));
208: $title = &Apache::lonnet::escape($title);
209: $xlabel = &Apache::lonnet::escape($xlabel);
210: $ylabel = &Apache::lonnet::escape($ylabel);
211: #
212: my $sendValues1 = join(',', @$values1);
213: my $sendValues2;
214: if (defined($values2)) {
215: $sendValues2 = join(',', @$values2);
216: }
217:
218: my $sendCount = scalar(@$values1);
219: $MaxY =1 if ($MaxY < 1);
220: if ( int($MaxY) < $MaxY ) {
221: $MaxY++;
222: $MaxY = int($MaxY);
223: }
224: my @GData = ($title,$xlabel,$ylabel,$MaxY,$sendCount,$sendValues1);
225: if (defined($sendValues2)) {
226: push (@GData,$sendValues2);
227: }
228: return '<IMG src="/cgi-bin/graph.png?'.
229: (join('&', @GData)).'" border="1" />';
230: }
231:
232:
233:
234: sub get_problem_symb {
235: my $problemstring = shift();
236: my ($symb,$partid,$resid) = ($problemstring=~ /^(.*):([^:]*):([^:]*)$/);
237: return ($symb,$partid,$resid);
238: }
239:
240: sub CreateInterface {
241: my $Str = '';
242: $Str .= '<table cellspacing="5">'."\n";
243: $Str .= '<tr>';
244: $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
245: $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
246: $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
247: $Str .= '</tr>'."\n";
248: #
249: $Str .= '<tr><td align="center">'."\n";
250: $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
251: $Str .= '</td><td align="center">';
252: $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
253: $Str .= '</td><td align="center">';
254: my $only_seq_with_assessments = sub {
255: my $s=shift;
256: if ($s->{'num_assess'} < 1) {
257: return 0;
258: } else {
259: return 1;
260: }
261: };
262: $Str .= &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
263: $only_seq_with_assessments);
264: $Str .= '</td></tr>'."\n";
265: $Str .= '</table>'."\n";
266: $Str .= '<input type="submit" name="ProblemAnalysis" value="'.
267: &mt('Analyze Problem').'" />';
268: $Str .= ' 'x5;
269: $Str .= '<input type="submit" name="ClearCache" value="'.
270: &mt('Clear Caches').'" />';
271: $Str .= ' 'x5;
272: return ($Str);
273: }
274:
275: sub OptionResponseProblemSelector {
276: my $Str;
277: $Str = "\n<table>\n";
278: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
279: next if ($seq->{'num_assess'}<1);
280: my $seq_str = '';
281: foreach my $res (@{$seq->{'contents'}}) {
282: # &Apache::lonnet::logthis('checking '.$res->{'title'});
283: # next if ($res->{'type'} ne 'assessment');
284: foreach my $part (@{$res->{'parts'}}) {
285: my $partdata = $res->{'partdata'}->{$part};
286: if (! exists($partdata->{'option'}) ||
287: $partdata->{'option'} == 0) {
288: next;
289: }
290: for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
291: my $respid = $partdata->{'ResponseIds'}->[$i];
292: my $resptype = $partdata->{'ResponseTypes'}->[$i];
293: if ($resptype eq 'option') {
294: my $value = &Apache::lonnet::escape($res->{'symb'}.':'.$part.':'.$respid);
295: my $checked = '';
296: if ($ENV{'form.problemchoice'} eq $value) {
297: $checked = 'checked ';
298: }
299: $seq_str .= '<tr><td>'.
300: '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
301: '</td><td>'.
302: '<a href="'.$res->{'src'}.'">'.$res->{'title'}.'</a> ';
303: if ($partdata->{'option'} > 1) {
304: $seq_str .= &mt('response').' '.$respid;
305: }
306: $seq_str .= "</td></tr>\n";
307: }
308: }
309: }
310: }
311: if ($seq_str ne '') {
312: $Str .= '<tr><td> </td><td><b>'.$seq->{'title'}.'</b></td>'.
313: "</tr>\n".$seq_str;
314: }
315: }
316: $Str .= "</table>\n";
317: return $Str;
318: }
319:
320: sub get_resource_from_symb {
321: my ($symb) = @_;
322: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
323: foreach my $res (@{$seq->{'contents'}}) {
324: if ($res->{'symb'} eq $symb) {
325: return $res;
326: }
327: }
328: }
329: return undef;
330: }
331:
332: sub get_problem_data {
333: my ($url) = @_;
334: # my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze',
335: # 'grade_username' => $sname,
336: # 'grade_domain' => $sdom,
337: # 'grade_courseid' => $cid,
338: # 'grade_symb' => $symb));
339: my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
340: (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
341: my %Answer;
342: %Answer=&Apache::lonnet::str2hash($Answ);
343: # &Apache::lonnet::logthis('keys of %Answer = '.join(', ',(keys(%Answer))));
344: # &Apache::lonnet::logthis('$Answer{parts} = '.
345: # join(', ',@{$Answer{'parts'}}));
346: my %Partdata;
347: foreach my $part (@{$Answer{'parts'}}) {
348: while (my($key,$value) = each(%Answer)) {
349: next if ($key !~ /^$part/);
350: $key =~ s/^$part\.//;
351: if (ref($value) eq 'ARRAY') {
352: if ($key eq 'options') {
353: $Partdata{$part}->{'Options'}=$value;
354: } elsif ($key eq 'concepts') {
355: $Partdata{$part}->{'Concepts'}=$value;
356: } elsif ($key =~ /^concept\.(.*)$/) {
357: my $concept = $1;
358: foreach my $foil (@$value) {
359: $Partdata{$part}->{$foil}->{'Concept'}=$concept;
360: }
361: }
362: &Apache::lonnet::logthis($part.' '.$key.' (array) = '.
363: join(', ',@$value));
364: } else {
365: $value =~ s/^\s*//g;
366: $value =~ s/\s*$//g;
367: if ($key=~ /^foil\.text\.(.*)$/) {
368: my $foil = $1;
369: $Partdata{$part}->{'Foiltext'}->{$foil}=$value;
370: } elsif ($key =~ /^foil\.value\.(.*)$/) {
371: my $foil = $1;
372: $Partdata{$part}->{'FoilValues'}->{$foil}=$value;
373: }
374: &Apache::lonnet::logthis($part.' '.$key.' = '.$value);
375: }
376: }
377: }
378:
379: # my $parts='';
380: # foreach my $elm (@{$Answer{"parts"}}) {
381: # $parts.="$elm,";
382: # }
383: # chop($parts);
384: # my $conc='';
385: # foreach my $elm (@{$Answer{"$parts.concepts"}}) {
386: # $conc.="$elm@";
387: # }
388: # chop($conc);
389: #
390: # @Concepts=split(/\@/,$conc);
391: # foreach my $concept (@{$Answer{"$parts.concepts"}}) {
392: # foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
393: # $foil_to_concept{$foil} = $concept;
394: # #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
395: # }
396: # }
397: # return $symb;
398: return %Partdata;
399: }
400:
401: 1;
402:
403: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>