File:
[LON-CAPA] /
loncom /
interface /
statistics /
lonproblemanalysis.pm
Revision
1.99:
download - view:
text,
annotated -
select for diffs
Fri Oct 29 16:10:30 2004 UTC (19 years, 8 months ago) by
matthew
Branches:
MAIN
CVS tags:
HEAD
RR_create_percent_selected_plot: Fixed bug where if a foil could be true for
some students but not all students the bar for the foil would appear
green (indicating true) for everyone. Now keep track of those for whom
the foil is true seperately than those for whom the foil is false and
produce a stacked bar graph (green & red = true & false).
1: # The LearningOnline Network with CAPA
2: #
3: # $Id: lonproblemanalysis.pm,v 1.99 2004/10/29 16:10:30 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: package Apache::lonproblemanalysis;
28:
29: use strict;
30: use Apache::lonnet();
31: use Apache::loncommon();
32: use Apache::lonhtmlcommon();
33: use Apache::loncoursedata();
34: use Apache::lonstatistics;
35: use Apache::lonlocal;
36: use Apache::lonstathelpers();
37: use Apache::lonstudentsubmissions();
38: use HTML::Entities();
39: use Time::Local();
40: use Spreadsheet::WriteExcel();
41:
42: my $plotcolors = ['#33ff00',
43: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
44: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
45: ];
46:
47: my @SubmitButtons = ({ name => 'PrevProblemAnalysis',
48: text => 'Previous Problem' },
49: { name => 'ProblemAnalysis',
50: text => 'Analyze Problem Again' },
51: { name => 'NextProblemAnalysis',
52: text => 'Next Problem' },
53: { name => 'break'},
54: { name => 'SelectAnother',
55: text => 'Choose a different Problem' },
56: { name => 'ExcelOutput',
57: text => 'Produce Excel Output' });
58:
59: sub BuildProblemAnalysisPage {
60: my ($r,$c)=@_;
61: #
62: my %Saveable_Parameters = ('Status' => 'scalar',
63: 'Section' => 'array',
64: 'NumPlots' => 'scalar',
65: 'AnalyzeOver' => 'scalar',
66: );
67: &Apache::loncommon::store_course_settings('problem_analysis',
68: \%Saveable_Parameters);
69: &Apache::loncommon::restore_course_settings('problem_analysis',
70: \%Saveable_Parameters);
71: #
72: &Apache::lonstatistics::PrepareClasslist();
73: #
74: $r->print(&CreateInterface());
75: #
76: my @Students = @Apache::lonstatistics::Students;
77: #
78: if (@Students < 1 && exists($ENV{'form.firstrun'})) {
79: $r->print('<h2>There are no students in the sections selected</h2>');
80: }
81: #
82: my @CacheButtonHTML =
83: &Apache::lonstathelpers::manage_caches($r,'Statistics','stats_status');
84: $r->rflush();
85: #
86: # Support for numerical and radio response isn't complete enough to
87: # include in 1.2 release.
88: # my $problem_types = '(option|radiobutton|numerical)';
89: my $problem_types = '.';#(option)';
90: if (exists($ENV{'form.problemchoice'}) &&
91: ! exists($ENV{'form.SelectAnother'})) {
92: foreach my $button (@SubmitButtons) {
93: if ($button->{'name'} eq 'break') {
94: $r->print("<br />\n");
95: } else {
96: $r->print('<input type="submit" name="'.$button->{'name'}.'" '.
97: 'value="'.&mt($button->{'text'}).'" />');
98: $r->print(' 'x5);
99: }
100: }
101: foreach my $html (@CacheButtonHTML) {
102: $r->print($html.(' 'x5));
103: }
104: #
105: $r->print('<hr />');
106: $r->rflush();
107: #
108: # Determine which problem we are to analyze
109: my $current_problem = &Apache::lonstathelpers::get_target_from_id
110: ($ENV{'form.problemchoice'});
111: #
112: my ($prev,$curr,$next) =
113: &Apache::lonstathelpers::get_prev_curr_next($current_problem,
114: $problem_types,
115: 'response',
116: );
117: if (exists($ENV{'form.PrevProblemAnalysis'}) && defined($prev)) {
118: $current_problem = $prev;
119: } elsif (exists($ENV{'form.NextProblemAnalysis'}) && defined($next)) {
120: $current_problem = $next;
121: } else {
122: $current_problem = $curr;
123: }
124: #
125: # Store the current problem choice and send it out in the form
126: $ENV{'form.problemchoice'} =
127: &Apache::lonstathelpers::make_target_id($current_problem);
128: $r->print('<input type="hidden" name="problemchoice" value="'.
129: $ENV{'form.problemchoice'}.'" />');
130: #
131: if (! defined($current_problem->{'resource'})) {
132: $r->print('resource is undefined');
133: } else {
134: my $resource = $current_problem->{'resource'};
135: $r->print('<h1>'.$resource->{'title'}.'</h1>');
136: $r->print('<h3>'.$resource->{'src'}.'</h3>');
137: if ($ENV{'form.show_prob'} eq 'true') {
138: $r->print(&Apache::lonstathelpers::render_resource($resource));
139: }
140: $r->rflush();
141: my %Data = &Apache::lonstathelpers::get_problem_data
142: ($resource->{'src'});
143: my $problem_data = $Data{$current_problem->{'part'}.
144: '.'.
145: $current_problem->{'respid'}};
146: if ($current_problem->{'resptype'} eq 'option') {
147: &OptionResponseAnalysis($r,$current_problem,
148: $problem_data,
149: \@Students);
150: } elsif ($current_problem->{'resptype'} eq 'radiobutton') {
151: &radio_response_analysis($r,$current_problem,
152: $problem_data,
153: \@Students);
154: } elsif ($current_problem->{'resptype'} eq 'numerical') {
155: ##
156: ## analyze all responses of a problem at once
157: my $res = $current_problem->{'resource'};
158: foreach my $partid (@{$res->{'parts'}}) {
159: $current_problem->{'part'} = $partid;
160: foreach my $respid (@{$res->{'partdata'}->{$partid}->{'ResponseIds'}}) {
161: $current_problem->{'respid'}=$respid;
162: &NumericalResponseAnalysis($r,$current_problem,
163: $problem_data,\@Students);
164: }
165: }
166: } else {
167: $r->print('<h2>This analysis is not supported</h2>');
168: }
169: }
170: $r->print('<hr />');
171: } else {
172: $r->print('<input type="submit" name="ProblemAnalysis" value="'.
173: &mt('Analyze Problem').'" />');
174: $r->print(' 'x5);
175: $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
176: $r->print(&Apache::lonstathelpers::ProblemSelector
177: ($problem_types));
178: }
179: }
180:
181:
182: #########################################################
183: #########################################################
184: ##
185: ## Numerical Response Routines
186: ##
187: #########################################################
188: #########################################################
189: sub NumericalResponseAnalysis {
190: my ($r,$problem,$problem_data,$Students) = @_;
191: my $c = $r->connection();
192: my ($resource,$partid,$respid) = ($problem->{'resource'},
193: $problem->{'part'},
194: $problem->{'respid'});
195: #
196: if (scalar(@{$resource->{'parts'}})>1) {
197: if (@{$resource->{'partdata'}->{$partid}->{'ResponseIds'}}>1) {
198: $r->print('<h3>'.
199: &mt('Part [_1], response [_2].',$partid,$respid).
200: '</h3>');
201: } else {
202: $r->print('<h3>'.
203: &mt('Part [_1]',$partid,$respid).
204: '</h3>');
205: }
206: } elsif (@{$resource->{'partdata'}->{$partid}->{'ResponseIds'}}>1) {
207: $r->print('<h3>'.&mt('Response [_1]',$respid).'</h3>');
208: }
209: #
210: my $analysis_html;
211: my $PerformanceData = &Apache::loncoursedata::get_response_data
212: (\@Apache::lonstatistics::SelectedSections,
213: $Apache::lonstatistics::enrollment_status,
214: $resource->{'symb'},$respid);
215: if (! defined($PerformanceData) ||
216: ref($PerformanceData) ne 'ARRAY' ) {
217: $analysis_html = '<h2>'.
218: &mt('There is no submission data for this resource').
219: '</h2>';
220: $r->print($analysis_html);
221: return;
222: }
223: #
224: # This next call causes all the waiting around that people complain about
225: &Apache::lonstathelpers::GetStudentAnswers($r,$problem,$Students,
226: 'Statistics',
227: 'stats_status');
228: return if ($c->aborted());
229: #
230: # Collate the data
231: my %Data;
232: foreach my $student (@$Students) {
233: my $answer = $student->{'answer'};
234: $Data{$answer}++;
235: }
236: my @Labels = sort {$a <=> $b } keys(%Data);
237: my @PlotData = @Data{@Labels};
238: #
239: my $width = 500;
240: my $height = 100;
241: my $plot = &one_dimensional_plot($r,500,100,scalar(@$Students),
242: \@Labels,\@PlotData);
243: $r->print($plot);
244: return;
245: }
246:
247: sub one_dimensional_plot {
248: my ($r,$width,$height,$N,$Labels,$Data)=@_;
249: #
250: # Compute data -> image scaling factors
251: my $min = $Labels->[0];
252: my $max = $Labels->[-1];
253: if ($max == $min) {
254: $max =$min+1;
255: }
256: my $h_scale = ($width-10)/($max-$min);
257: #
258: my $max_y = 0;
259: foreach (@$Data) {
260: $max_y = $_ if ($max_y < $_);
261: }
262: my $ticscale = 5;
263: if ($max_y * $ticscale > $height/2) {
264: $ticscale = int($height/2/$max_y);
265: $ticscale = 1 if ($ticscale < 1);
266: }
267: #
268: # Create the plot
269: my $plot =
270: qq{<drawimage width="$width" height="$height" bgcolor="transparent" >};
271: for (my $idx=0;$idx<scalar(@$Labels);$idx++) {
272: my $xloc = 5+$h_scale*($Labels->[$idx] - $min);
273: my $top = $height/2-$Data->[$idx]*$ticscale;
274: my $bottom = $height/2+$Data->[$idx]*$ticscale;
275: $plot .=
276: &line($xloc,$top,$xloc,$bottom,'888888',1);
277: }
278: #
279: # Put the scale on last to ensure it is on top of the data.
280: if ($min < 0 && $max > 0) {
281: my $circle_x = 5+$h_scale*abs($min); # '0' in data coordinates
282: my $r = 4;
283: $plot .= &line(5,$height/2,$circle_x-$r,$height/2,'000000',1);
284: $plot .= &circle($circle_x,$height/2,$r+1,'000000');
285: $plot .= &line($circle_x+$r,$height/2,$width-5,$height/2,'000000',1);
286: } else {
287: $plot .= &line(5,$height/2,$width-5,$height/2,'000000',1);
288: }
289: $plot .= '</drawimage>';
290: my $plotresult = &Apache::lonxml::xmlparse($r,'web',$plot);
291:
292: my $title = 'Distribution of correct answers';
293: my $result = '<table>'.
294: '<tr><td colspan="3" align="center">'.
295: '<font size="+2">'.$title.' (N='.$N.')'.
296: '</font>'.
297: '</td></tr>'.
298: '<tr>'.
299: '<td valign="center">'.$min.'</td>'.
300: '<td>'.$plotresult.'</td>'.
301: '<td valign="center">'.$max.'</td>'.
302: '</tr>'.
303: '<tr><td colspan="3" align="center">'.
304: 'Maximum Number of Coinciding Values: '.$max_y.
305: '</td></tr>'.
306: '</table>';
307: return $result;
308: }
309:
310: ##
311: ## Helper subroutines for <drawimage>.
312: ## These should probably go somewhere more suitable soon.
313: sub line {
314: my ($x1,$y1,$x2,$y2,$color,$thickness) = @_;
315: return qq{<line x1="$x1" y1="$y1" x2="$x2" y2="$y2" color="$color" thickness="$thickness" />$/};
316: }
317:
318: sub text {
319: my ($x,$y,$color,$text,$font,$direction) = @_;
320: if (! defined($font) || $font !~ /^(tiny|small|medium|large|giant)$/) {
321: $font = 'medium';
322: }
323: if (! defined($direction) || $direction ne 'vertical') {
324: $direction = '';
325: }
326: return qq{<text x="$x" y="$y" color="$color" font="$font" direction="$direction" >$text</text>};
327: }
328:
329: sub rectangle {
330: my ($x1,$y1,$x2,$y2,$color,$thickness,$filled) = @_;
331: return qq{<rectangle x1="$x1" y1="$y1" x2="$x2" y2="$y2" color="$color" thickness="$thickness" filled="$filled" />};
332: }
333:
334: sub arc {
335: my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)=@_;
336: return qq{<arc x="$x" y="$y" width="$width" height="$height" start="$start" end="$end" color="$color" thickness="$thickness" filled="$filled" />};
337: }
338:
339: sub circle {
340: my ($x,$y,$radius,$color,$thickness,$filled)=@_;
341: return &arc($x,$y,$radius,$radius,0,360,$color,$thickness,$filled);
342: }
343:
344: sub build_student_data_worksheet {
345: my ($workbook,$format) = @_;
346: my $rows_output = 3;
347: my $cols_output = 0;
348: my $worksheet = $workbook->addworksheet('Student Data');
349: $worksheet->write($rows_output++,0,'Student Data',$format->{'h3'});
350: my @Headers = ('full name','username','domain','section',
351: "student\nnumber",'identifier');
352: $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
353: my @Students = @Apache::lonstatistics::Students;
354: my $studentrows = &Apache::loncoursedata::get_student_data(\@Students);
355: my %ids;
356: foreach my $row (@$studentrows) {
357: my ($mysqlid,$student) = @$row;
358: $ids{$student}=$mysqlid;
359: }
360: foreach my $student (@Students) {
361: my $name_domain = $student->{'username'}.':'.$student->{'domain'};
362: $worksheet->write_row($rows_output++,0,
363: [$student->{'fullname'},
364: $student->{'username'},$student->{'domain'},
365: $student->{'section'},$student->{'id'},
366: $ids{$name_domain}]);
367: }
368: return $worksheet;
369: }
370:
371: #########################################################
372: #########################################################
373: ##
374: ## Radio Response Routines
375: ##
376: #########################################################
377: #########################################################
378: sub radio_response_analysis {
379: my ($r,$problem,$problem_analysis,$students) = @_;
380: #
381: if ($ENV{'form.AnalyzeOver'} !~ /^(tries|time)$/) {
382: $r->print('Bad request');
383: }
384: #
385: my ($resource,$partid,$respid) = ($problem->{'resource'},
386: $problem->{'part'},
387: $problem->{'respid'});
388: #
389: my $analysis_html;
390: my $foildata = $problem_analysis->{'_Foils'};
391: my ($table,$foils,$concepts) = &build_foil_index($problem_analysis);
392: #
393: my %true_foils;
394: my $num_true = 0;
395: if (! $problem_analysis->{'answercomputed'}) {
396: foreach my $foil (@$foils) {
397: if ($foildata->{$foil}->{'value'} eq 'true') {
398: $true_foils{$foil}++;
399: }
400: }
401: $num_true = scalar(keys(%true_foils));
402: }
403: #
404: $analysis_html .= $table;
405: # Gather student data
406: my $response_data = &Apache::loncoursedata::get_response_data
407: (\@Apache::lonstatistics::SelectedSections,
408: $Apache::lonstatistics::enrollment_status,
409: $resource->{'symb'},$respid);
410: my $correct; # either a hash reference or a scalar
411: if ($problem_analysis->{'answercomputed'} || scalar(@$concepts) > 1) {
412: # This takes a while for large classes...
413: &Apache::lonstathelpers::GetStudentAnswers($r,$problem,$students,
414: 'Statistics',
415: 'stats_status');
416: foreach my $student (@$students) {
417: my ($idx,@remainder) = split('&',$student->{'answer'});
418: my ($answer) = ($remainder[$idx]=~/^(.*)=([^=]*)$/);
419: $correct->{$student->{'username'}.':'.$student->{'domain'}}=
420: &Apache::lonnet::unescape($answer);
421: }
422: } else {
423: foreach my $foil (keys(%$foildata)) {
424: if ($foildata->{$foil}->{'value'} eq 'true') {
425: $correct = $foildata->{$foil}->{'name'};
426: }
427: }
428: }
429: #
430: if (! defined($response_data) || ref($response_data) ne 'ARRAY' ) {
431: $analysis_html = '<h2>'.
432: &mt('There is no submission data for this resource').
433: '</h2>';
434: $r->print($analysis_html);
435: return;
436: }
437: #
438: $analysis_html.='<table>';
439: for (my $plot_num = 1;$plot_num<=$ENV{'form.NumPlots'};$plot_num++) {
440: # classify data ->correct foil -> selected foil
441: my ($restriction_function,
442: $correct_foil_title,$incorrect_foil_title,
443: $pre_graph_text,$post_graph_text,
444: $no_data_text,@extra_data);
445: if ($ENV{'form.AnalyzeOver'} eq 'tries') {
446: $restriction_function = sub {($_[0]->{'tries'} == $plot_num?1:0)};
447: $correct_foil_title = 'Attempt '.$plot_num;
448: $incorrect_foil_title = 'Attempt '.$plot_num;
449: $pre_graph_text =
450: 'Attempt [_1], [_2] submissions, [_3] correct, [_4] incorrect';
451: $post_graph_text = '';
452: $no_data_text = 'No data exists for attempt [_1]';
453: } elsif ($ENV{'form.AnalyzeOver'} eq 'time') {
454: my $starttime = &Apache::lonhtmlcommon::get_date_from_form
455: ('startdate_'.$plot_num);
456: my $endtime = &Apache::lonhtmlcommon::get_date_from_form
457: ('enddate_'.$plot_num);
458: ($starttime,$endtime) = &ensure_start_end_times
459: ($starttime,$endtime,
460: &get_time_from_row($response_data->[0]),
461: &get_time_from_row($response_data->[-1]),
462: $plot_num);
463: $pre_graph_text =
464: 'Data from [_5] to [_6], [_2] submissions, [_3] correct, [_4] incorrect';
465: $extra_data[0] = &Apache::lonlocal::locallocaltime($starttime);
466: $extra_data[1] = &Apache::lonlocal::locallocaltime($endtime);
467: #
468: $post_graph_text =
469: &mt('Start time: [_1]',
470: &Apache::lonhtmlcommon::date_setter
471: ('Statistics','startdate_'.$plot_num,$starttime)).
472: '<br />'.
473: &mt('End time: [_1]',
474: &Apache::lonhtmlcommon::date_setter
475: ('Statistics','enddate_'.$plot_num,$endtime));
476: $restriction_function =
477: sub {
478: my $t = $_[0]->{'timestamp'};
479: if ($t >= $starttime && $t < $endtime) {
480: return 1;
481: } else {
482: return 0;
483: }
484: };
485: $no_data_text = 'No data for [_5] to [_6]';
486: }
487: my $foil_choice_data =
488: &RR_classify_response_data($response_data,$correct,
489: $restriction_function);
490: # &Apache::lonstathelpers::log_hash_ref($foil_choice_data);
491: my $answers;
492: if (ref($correct)) {
493: my %tmp;
494: foreach my $foil (values(%$correct)) {
495: $tmp{$foil}++;
496: }
497: $answers = [keys(%tmp)];
498: } else {
499: $answers = [$correct];
500: }
501: # Concept Plot
502: my $concept_plot = '';
503: if (scalar(@$concepts) > 1) {
504: $concept_plot = &RR_concept_plot($concepts,$foil_choice_data,
505: 'Correct Concepts');
506: }
507: # % Choosing plot
508: my $choice_plot = &RR_create_percent_selected_plot
509: ($concepts,$foils,$foil_choice_data,$correct_foil_title);
510: # for each correct foil, how did they mark it? (stacked bar graph)
511: my ($stacked_plot,$count_by_foil);
512: if ($problem_analysis->{'answercomputed'} || $num_true > 1) {
513: ($stacked_plot,$count_by_foil) =
514: &RR_create_stacked_selection_plot($foils,$foil_choice_data,
515: $incorrect_foil_title,
516: \%true_foils);
517: }
518: #
519: if ($concept_plot ne '' ||
520: $choice_plot ne '' ||
521: $stacked_plot ne '') {
522: my $correct = $foil_choice_data->{'_correct'};
523: if (! defined($correct) || $correct eq '') {
524: $correct = 0;
525: }
526: my $incorrect =
527: $analysis_html.= '<tr><td colspan="4" align="center">'.
528: '<font size="+1">'.
529: &mt($pre_graph_text,
530: $plot_num,$foil_choice_data->{'_count'},
531: $correct,
532: $foil_choice_data->{'_count'}-$correct,
533: @extra_data).
534: '</td></tr>'.$/;
535: $analysis_html.=
536: '<tr>'.
537: '<td>'.$concept_plot.'</td>'.
538: '<td>'.$choice_plot.'</td>';
539: if ($stacked_plot ne '') {
540: $analysis_html .=
541: '<td>'.$stacked_plot.'</td>'.
542: '<td>'.&build_foil_key($foils,$count_by_foil).'</td>';
543: } else {
544: $analysis_html .= ('<td></td>'x2);
545: }
546: $analysis_html.='</tr>'.$/;
547: if (defined($post_graph_text)) {
548: $analysis_html.= '<tr><td colspan="4" align="center">'.
549: $post_graph_text.'</td></tr>'.$/;
550: }
551: } elsif ($no_data_text ne '') {
552: $analysis_html.='<tr><td colspan="4" align="center">'.
553: &mt($no_data_text,
554: $plot_num,$foil_choice_data->{'_count'},
555: $correct,
556: $foil_choice_data->{'_count'}-$correct,
557: @extra_data);
558: if (defined($post_graph_text)) {
559: $analysis_html.='<br />'.$post_graph_text;
560: }
561: $analysis_html.='</td></tr>'.$/;
562: }
563: } # end of loop for plots
564: $analysis_html.='</table>';
565: $r->print($analysis_html);
566: }
567:
568: sub ensure_start_end_times {
569: my ($start,$end,$first,$last,$plot_num) = @_;
570: if (! defined($start) || ! defined($end)) {
571: my $sec_in_day = 86400;
572: my ($sday,$smon,$syear) =
573: (localtime($last - $sec_in_day*($plot_num-1)))[3..5];
574: $start = &Time::Local::timelocal(0,0,0,$sday,$smon,$syear);
575: $end = $start + $sec_in_day;
576: if ($plot_num == $ENV{'form.NumPlots'}) {
577: $start = $first;
578: }
579: }
580: return ($start,$end);
581: }
582:
583: sub RR_concept_plot {
584: my ($concepts,$foil_data,$title) = @_;
585: #
586: my %correct_by_concept;
587: my %incorrect_by_concept;
588: my %true;
589: foreach my $concept (@$concepts) {
590: foreach my $foil (@{$concept->{'foils'}}) {
591: next if (! exists($foil_data->{$foil}));
592: foreach my $choice (keys(%{$foil_data->{$foil}})) {
593: if ($choice eq $foil) {
594: $correct_by_concept{$concept->{'name'}} +=
595: $foil_data->{$foil}->{$choice};
596: } else {
597: $incorrect_by_concept{$concept->{'name'}} +=
598: $foil_data->{$foil}->{$choice};
599:
600: }
601: }
602: }
603: }
604: #
605: # need arrays for incorrect and correct because we want to use different
606: # colors for them
607: my @correct;
608: #
609: my $total =0;
610: for (my $i=0;$i<scalar(@$concepts);$i++) {
611: my $concept = $concepts->[$i];
612: $correct[$i] = $correct_by_concept{$concept->{'name'}};
613: $total += $correct_by_concept{$concept->{'name'}}+
614: $incorrect_by_concept{$concept->{'name'}};
615: }
616: if ($total == 0) { return ''; };
617: for (my $i=0;$i<=$#correct;$i++) {
618: $correct[$i] = sprintf('%0f',$correct[$i]/$total*100);
619: }
620: my $xlabel = 'concept';
621: my $plot= &Apache::loncommon::DrawBarGraph($title,
622: $xlabel,
623: 'Percent Choosing',
624: 100,
625: ['#33ff00','#ff3300'],
626: undef,
627: \@correct);
628: return $plot;
629: }
630:
631: sub RR_create_percent_selected_plot {
632: my ($concepts,$foils,$foil_data,$title) = @_;
633: #
634: if ($foil_data->{'_count'} == 0) { return ''; };
635: my %correct_selections;
636: my %incorrect_selections;
637: foreach my $foil (@$foils) {
638: # foil_data has format $foil_data->{true_foil}->{selected foil}
639: next if (! exists($foil_data->{$foil}));
640: while (my ($f,$count)= each(%{$foil_data->{$foil}})) {
641: if ($f eq $foil) {
642: $correct_selections{$foil} += $count;
643: } else {
644: $incorrect_selections{$foil} += $count;
645: }
646: }
647: }
648: #
649: # need arrays for incorrect and correct because we want to use different
650: # colors for them
651: my @correct;
652: my @incorrect;
653: #
654: my $total = $foil_data->{'_count'};
655: for (my $i=0;$i<scalar(@$foils);$i++) {
656: my $foil = $foils->[$i];
657: $correct[$i] = $correct_selections{$foil};
658: $incorrect[$i] = $incorrect_selections{$foil};
659: }
660: for (my $i=0;$i<=$#correct;$i++) {
661: &Apache::lonnet::logthis('correct['.$i.']='.$correct[$i]);
662: $correct[$i] = sprintf('%2f',$correct[$i]/$total*100);
663: }
664: for (my $i=0;$i<=$#incorrect;$i++) {
665: $incorrect[$i] = sprintf('%2f',$incorrect[$i]/$total*100);
666: }
667: #
668: # Put a blank in the data sets between concepts, if there are concepts
669: my @labels;
670: if (defined($concepts) && scalar(@$concepts) > 1) {
671: my @new_correct;
672: my @new_incorrect;
673: my $foil_count = 0;
674: foreach my $concept (@$concepts) {
675: foreach (@{$concept->{'foils'}}) {
676: push(@new_correct, $correct[$foil_count]);
677: push(@new_incorrect,$incorrect[$foil_count]);
678: push(@labels,++$foil_count);
679: }
680: push(@new_correct,'');
681: push(@new_incorrect,'');
682: push(@labels,'');
683: }
684: @correct = @new_correct;
685: @incorrect = @new_incorrect;
686: } else {
687: @labels = (1 .. scalar(@correct));
688: }
689: #
690: my $xlabel = 'foil chosen';
691: my $plot= &Apache::loncommon::DrawBarGraph($title,
692: $xlabel,
693: 'Percent Choosing',
694: 100,
695: ['#33ff00','#ff3300'],
696: \@labels,
697: \@correct,
698: \@incorrect);
699: return $plot;
700: }
701:
702: sub RR_create_stacked_selection_plot {
703: my ($foils,$foil_data,$title,$true_foils)=@_;
704: #
705: my @dataset; # array of array refs - multicolor rows $datasets[row]->[col]
706: my @labels;
707: my $count;
708: my %column; # maps foil name to column in @datasets
709: for (my $i=0;$i<scalar(@$foils);$i++) {
710: my $foil = $foils->[$i];
711: if (defined($true_foils) && scalar(keys(%$true_foils)) > 0 ) {
712: next if (! $true_foils->{$foil} );
713: push(@labels,$i+1);
714: } else {
715: next if (! exists($foil_data->{$foil}));
716: push(@labels,$i+1);
717: }
718: next if (! exists($foil_data->{$foils->[$i]}));
719: $column{$foil}= $count++;
720: for (my $j=0;$j<scalar(@$foils);$j++) {
721: my $value = 0;
722: if ($i != $j ) {
723: $value += $foil_data->{$foil}->{$foils->[$j]};
724: }
725: $dataset[$j]->[$column{$foil}]=$value;
726: }
727: }
728: #
729: return '' if (! scalar(keys(%column)));
730: #
731: my $grand_total = 0;
732: my %count_per_foil;
733: while (my ($foil,$bar) = each (%column)) {
734: my $bar_total = 0;
735: for (my $j=0;$j<scalar(@dataset);$j++) {
736: $bar_total += $dataset[$j]->[$bar];
737: }
738: next if ($bar_total == 0);
739: for (my $j=0;$j<scalar(@dataset);$j++) {
740: $dataset[$j]->[$bar] =
741: sprintf('%2f',$dataset[$j]->[$bar]/$bar_total * 100);
742: }
743: $count_per_foil{$foil}=' ( '.$bar_total.' )';
744: $grand_total += $bar_total;
745: }
746: if ($grand_total == 0) {
747: return ('',undef);
748: }
749: my @empty_row = ();
750: foreach (@{$dataset[0]}) {
751: push(@empty_row,0);
752: }
753: #
754: my $graph = &Apache::loncommon::DrawBarGraph
755: ($title,'Correct Foil','foils chosen Incorrectly',
756: 100,$plotcolors,\@labels,\@empty_row,@dataset);
757: return ($graph,\%count_per_foil);
758: }
759:
760: # if $correct is a hash ref, it is assumed to be indexed by student names.
761: # the values are assumed to be hash refs with a key of 'answer'.
762: sub RR_classify_response_data {
763: my ($full_row_data,$correct,$function) = @_;
764: my %submission_data;
765: foreach my $row (@$full_row_data) {
766: my %subm = &hashify_attempt($row);
767: if (ref($correct) eq 'HASH') {
768: $subm{'correct'} = $correct->{$subm{'student'}};
769: } else {
770: $subm{'correct'} = $correct;
771: }
772: $subm{'submission'} =~ s/=\d+\s*$//;
773: if (&$function(\%subm)) {
774: $submission_data{'_count'}++;
775: if (&submission_is_correct($subm{'award'})) {
776: $submission_data{'_correct'}++;
777: }
778: $submission_data{$subm{'correct'}}->{$subm{'submission'}}++;
779: }
780: }
781: return \%submission_data;
782: }
783:
784:
785: #########################################################
786: #########################################################
787: ##
788: ## Option Response Routines
789: ##
790: #########################################################
791: #########################################################
792: sub OptionResponseAnalysis {
793: my ($r,$problem,$problem_data,$Students) = @_;
794: my ($resource,$respid) = ($problem->{'resource'},
795: $problem->{'respid'});
796: # Note: part data is not needed.
797: my $PerformanceData = &Apache::loncoursedata::get_response_data
798: (\@Apache::lonstatistics::SelectedSections,
799: $Apache::lonstatistics::enrollment_status,
800: $resource->{'symb'},$respid);
801: if (! defined($PerformanceData) ||
802: ref($PerformanceData) ne 'ARRAY' ) {
803: $r->print('<h2>'.
804: &mt('There is no student data for this problem.').
805: '</h2>');
806: } else {
807: $r->rflush();
808: if (exists($ENV{'form.ExcelOutput'})) {
809: my $result = &OR_excel_sheet($r,$resource,
810: $PerformanceData,
811: $problem_data);
812: $r->print($result);
813: $r->rflush();
814: } else {
815: if ($ENV{'form.AnalyzeOver'} eq 'tries') {
816: my $analysis_html = &OR_tries_analysis($r,
817: $PerformanceData,
818: $problem_data);
819: $r->print($analysis_html);
820: $r->rflush();
821: } elsif ($ENV{'form.AnalyzeOver'} eq 'time') {
822: my $analysis_html = &OR_time_analysis($PerformanceData,
823: $problem_data);
824: $r->print($analysis_html);
825: $r->rflush();
826: } else {
827: $r->print('<h2>'.
828: &mt('The analysis you have selected is '.
829: 'not supported at this time').
830: '</h2>');
831: }
832: }
833: }
834: }
835:
836: #########################################################
837: #
838: # Option Response: tries Analysis
839: #
840: #########################################################
841: sub OR_tries_analysis {
842: my ($r,$PerformanceData,$ORdata) = @_;
843: my $mintries = 1;
844: my $maxtries = $ENV{'form.NumPlots'};
845: my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
846: my %response_data = &OR_analyze_by_tries($r,$PerformanceData,
847: $mintries,$maxtries);
848: my $analysis = '';
849: #
850: # Compute the data necessary to make the plots
851: my @foil_plot;
852: my @concept_data;
853: for (my $j=0;$j<=scalar(@$Concepts);$j++) {
854: my $concept = $Concepts->[$j];
855: foreach my $foilid (@{$concept->{'foils'}}) {
856: for (my $try=$mintries;$try<=$maxtries;$try++) {
857: # concept analysis data
858: $concept_data[$j]->[$try]->{'_correct'} +=
859: $response_data{$foilid}->[$try]->{'_correct'};
860: $concept_data[$j]->[$try]->{'_total'} +=
861: $response_data{$foilid}->[$try]->{'_total'};
862: #
863: # foil analysis data
864: if ($response_data{$foilid}->[$try]->{'_total'} == 0) {
865: push(@{$foil_plot[$try]->{'_correct'}},0);
866: } else {
867: push(@{$foil_plot[$try]->{'_correct'}},
868: 100*$response_data{$foilid}->[$try]->{'_correct'}/
869: $response_data{$foilid}->[$try]->{'_total'});
870: }
871: foreach my $option (@{$ORdata->{'_Options'}}) {
872: push(@{$foil_plot[$try]->{'_total'}},
873: $response_data{$foilid}->[$try]->{'_total'});
874: if ($response_data{$foilid}->[$try]->{'_total'} == 0) {
875: push (@{$foil_plot[$try]->{$option}},0);
876: } else {
877: if ($response_data{$foilid}->[$try]->{'_total'} ==
878: $response_data{$foilid}->[$try]->{'_correct'}) {
879: push(@{$foil_plot[$try]->{$option}},0);
880: } else {
881: push (@{$foil_plot[$try]->{$option}},
882: 100 *
883: $response_data{$foilid}->[$try]->{$option} /
884: ($response_data{$foilid}->[$try]->{'_total'}
885: -
886: $response_data{$foilid}->[$try]->{'_correct'}
887: ));
888: }
889: }
890: } # End of foreach my $option
891: }
892: } # End of foreach my $foilid
893: } # End of concept loops
894: #
895: # Build a table for the plots
896: my $analysis_html = "<br /><table>\n";
897: my $optionkey = &build_option_index($ORdata);
898: my $num_concepts = 1;
899: if (defined($Concepts)) { $num_concepts = scalar(@$Concepts); }
900: #
901: for (my $try=$mintries;$try<=$maxtries;$try++) {
902: if (! defined($response_data{'_total'}->[$try]) ||
903: $response_data{'_total'}->[$try] == 0) {
904: if ($try > 1) {
905: $analysis_html.= '<tr><td align="center" colspan="4"><b>'.
906: &mt('None of the selected students attempted the problem more than [_1] times.',$try-1).
907: '</b></td></tr>';
908: } else {
909: $analysis_html.= '<tr><td colspan="4" align="center"><b>'.
910: &mt('None of the selected students have attempted the problem').'</b></td></tr>';
911: }
912: last;
913: }
914: my $concept_graph='';
915: if ($num_concepts > 1) {
916: #
917: # Create concept plot
918: my @concept_plot_data;
919: for (my $j=0;$j<=$#concept_data;$j++) {
920: my $total = $concept_data[$j]->[$try]->{'_total'};
921: if ($total == 0) {
922: $concept_plot_data[$j] = 0;
923: } else {
924: $concept_plot_data[$j] = 100 *
925: sprintf('%0.3f',
926: $concept_data[$j]->[$try]->{'_correct'} /
927: $total);
928: }
929: }
930: #
931: $concept_graph = &Apache::loncommon::DrawBarGraph
932: ('Correct Concepts','Concept Number','Percent Correct',
933: 100,$plotcolors,undef,\@concept_plot_data);
934: }
935: #
936: # Create Foil Plots
937: my $data_count = $response_data{'_total'}->[$try];
938: my $correct = $response_data{'_correct'}->[$try];
939: my @Datasets;
940: foreach my $option ('_correct',@{$ORdata->{'_Options'}}) {
941: next if (! exists($foil_plot[$try]->{$option}));
942: push(@Datasets,$foil_plot[$try]->{$option});
943: }
944: #
945: # Put a blank in the data set between concepts
946: for (my $set =0;$set<=$#Datasets;$set++) {
947: my @Data = @{$Datasets[$set]};
948: my $idx = 0;
949: foreach my $concept (@{$Concepts}) {
950: foreach my $foilid (@{$concept->{'foils'}}) {
951: $Datasets[$set]->[$idx++]=shift(@Data);
952: }
953: if ($concept->{'name'} ne $Concepts->[-1]->{'name'}) {
954: $Datasets[$set]->[$idx++] = 0;
955: }
956: }
957: }
958: #
959: # Set up the labels needed for the bar graph
960: my @Labels;
961: my $idx = 1;
962: foreach my $concept (@{$Concepts}) {
963: foreach my $foilid (@{$concept->{'foils'}}) {
964: push(@Labels,$idx++);
965: }
966: push(@Labels,'');
967: }
968: #
969: my $correct_graph = &Apache::loncommon::DrawBarGraph
970: ('Correct Statements','Statement','% Answered Correct',
971: 100,$plotcolors,\@Labels,$Datasets[0]);
972:
973: #
974: #
975: next if (! defined($Datasets[0]));
976: for (my $i=0; $i< scalar(@{$Datasets[0]});$i++) {
977: $Datasets[0]->[$i]=0;
978: }
979: my $count = $response_data{'_total'}->[$try] -
980: $response_data{'_correct'}->[$try];
981: my $incorrect_graph = &Apache::loncommon::DrawBarGraph
982: ('Incorrect Statements','Statement','% Chosen Incorrectly',
983: 100,$plotcolors,\@Labels,@Datasets);
984: $analysis_html.=
985: '<tr><td colspan="4" align="center">'.
986: '<font size="+1">'.
987: &mt('Attempt [_1], [_2] submissions, [_3] correct, [_4] incorrect',
988: $try,$data_count,$correct,$data_count-$correct).
989: '</font>'.'</td></tr>'.$/.
990: '<tr>'.
991: '<td>'.$concept_graph.'</td>'.
992: '<td>'.$correct_graph.'</td>'.
993: '<td>'.$incorrect_graph.'</td>'.
994: '<td>'.$optionkey.'<td>'.
995: '</tr>'.$/;
996: }
997: $analysis_html .= "</table>\n";
998: $table .= $analysis_html;
999: return $table;
1000: }
1001:
1002: sub OR_analyze_by_tries {
1003: my ($r,$PerformanceData,$mintries,$maxtries) = @_;
1004: my %Trydata;
1005: $mintries = 1 if (! defined($mintries) || $mintries < 1);
1006: $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
1007: my @students;
1008: foreach my $row (@$PerformanceData) {
1009: next if (! defined($row));
1010: my $tries = &get_tries_from_row($row);
1011: my %Row = &Process_OR_Row($row);
1012: next if (! %Row);
1013: my $student_id = $row->[&Apache::loncoursedata::RD_student_id()];
1014: $students[$tries]->{$student_id}++;
1015: while (my ($foilid,$href) = each(%Row)) {
1016: if (! ref($href)) {
1017: $Trydata{$foilid}->[$tries] += $href;
1018: next;
1019: }
1020: while (my ($option,$value) = each(%$href)) {
1021: $Trydata{$foilid}->[$tries]->{$option}+=$value;
1022: }
1023: }
1024: }
1025: for (my $try=$mintries;$try<=$maxtries;$try++) {
1026: $Trydata{'_studentcount'}->[$try] = scalar(keys(%{$students[$try]}));
1027: }
1028: return %Trydata;
1029: }
1030:
1031: #########################################################
1032: #
1033: # Option Response: Time Analysis
1034: #
1035: #########################################################
1036: sub OR_time_analysis {
1037: my ($performance_data,$ORdata) = @_;
1038: my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
1039: my $foilkey = &build_option_index($ORdata);
1040: my $num_concepts = 1;
1041: if (defined($Concepts)) { $num_concepts = scalar(@$Concepts); }
1042: #
1043: if ($num_concepts < 2) {
1044: $table = '<h3>'.
1045: &mt('Not enough data for concept analysis. '.
1046: 'Performing Foil Analysis').
1047: '</h3>'.$table;
1048: }
1049: #
1050: my $num_plots = $ENV{'form.NumPlots'};
1051: my $num_data = scalar(@$performance_data)-1;
1052: #
1053: my $current_index;
1054: $table .= "<table>\n";
1055: for (my $i=0;$i<$num_plots;$i++) {
1056: ##
1057: my $starttime = &Apache::lonhtmlcommon::get_date_from_form
1058: ('startdate_'.$i);
1059: my $endtime = &Apache::lonhtmlcommon::get_date_from_form
1060: ('enddate_'.$i);
1061: if (! defined($starttime) || ! defined($endtime)) {
1062: my $sec_in_day = 86400;
1063: my $last_sub_time = &get_time_from_row($performance_data->[-1]);
1064: my ($sday,$smon,$syear) =
1065: (localtime($last_sub_time - $sec_in_day*$i))[3..5];
1066: $starttime = &Time::Local::timelocal(0,0,0,$sday,$smon,$syear);
1067: $endtime = $starttime + $sec_in_day;
1068: if ($i == ($num_plots -1 )) {
1069: $starttime = &get_time_from_row($performance_data->[0]);
1070: }
1071: }
1072: $table .= '<tr><td colspan="4" align="center"><font size="+1">'.
1073: &mt('Data from [_1] to [_2]',
1074: &Apache::lonlocal::locallocaltime($starttime),
1075: &Apache::lonlocal::locallocaltime($endtime)).
1076: '</font></td></tr>'.$/;
1077: my $startdateform = &Apache::lonhtmlcommon::date_setter
1078: ('Statistics','startdate_'.$i,$starttime);
1079: my $enddateform = &Apache::lonhtmlcommon::date_setter
1080: ('Statistics','enddate_'.$i,$endtime);
1081: #
1082: my $begin_index;
1083: my $end_index;
1084: my $j;
1085: while (++$j < scalar(@$performance_data)) {
1086: last if (&get_time_from_row($performance_data->[$j])
1087: > $starttime);
1088: }
1089: $begin_index = $j;
1090: while ($j < scalar(@$performance_data)) {
1091: if (&get_time_from_row($performance_data->[$j]) > $endtime) {
1092: last;
1093: } else {
1094: $j++;
1095: }
1096: }
1097: $end_index = $j;
1098: ##
1099: my ($processed_time_data,$correct,$data_count,$student_count) =
1100: &OR_time_process_data($performance_data,$begin_index,$end_index);
1101: ##
1102: $table .= '<tr><td colspan="4" align="center"><font size="+1">'.
1103: &mt('[_1] submissions from [_2] students submitting, [_3] correct, [_4] incorrect',
1104: $data_count,$student_count,$correct,$data_count-$correct).
1105: '</font></td></tr>'.$/;
1106: my $concept_correct_plot = '';
1107: if ($num_concepts > 1) {
1108: $concept_correct_plot =
1109: &OR_Concept_Time_Analysis($processed_time_data,
1110: $correct,$data_count,$student_count,
1111: $ORdata,$Concepts);
1112: }
1113: my ($foil_correct_plot,$foil_incorrect_plot) =
1114: &OR_Foil_Time_Analysis($processed_time_data,
1115: $correct,$data_count,$student_count,
1116: $ORdata,$Foils,$Concepts);
1117: $table .= '<tr>'.
1118: '<td>'.$concept_correct_plot.'</td>'.
1119: '<td>'.$foil_correct_plot.'</td>'.
1120: '<td>'.$foil_incorrect_plot.'</td>'.
1121: '<td align="left" valign="top">'.$foilkey.'</td></tr>'.$/;
1122: $table .= '<tr><td colspan="4" align="center">'.
1123: &mt('Start time: [_1]',$startdateform).'<br />'.
1124: &mt('End time: [_1]',$enddateform).'</td></tr>'.$/;
1125: $table.= '<tr><td colspan="4"> </td></tr>'.$/;
1126: }
1127: $table .= '</table>';
1128: #
1129: return $table;
1130: }
1131:
1132: sub OR_Foil_Time_Analysis {
1133: my ($processed_time_data,$correct,$data_count,$student_count,
1134: $ORdata,$Foils,$Concepts) = @_;
1135: if ($data_count <= 0) {
1136: return ('<h2>'.&mt('There is no data to plot').'</h2>','');
1137: }
1138: my $analysis_html;
1139: my @plotdata;
1140: my @labels;
1141: foreach my $concept (@{$Concepts}) {
1142: foreach my $foil (@{$concept->{'foils'}}) {
1143: push(@labels,scalar(@labels)+1);
1144: my $total = $processed_time_data->{$foil}->{'_total'};
1145: if ($total == 0) {
1146: push(@{$plotdata[0]},0);
1147: } else {
1148: push(@{$plotdata[0]},
1149: 100 * $processed_time_data->{$foil}->{'_correct'} / $total);
1150: }
1151: my $total_incorrect = $total - $processed_time_data->{$foil}->{'_correct'};
1152: for (my $i=0;$i<scalar(@{$ORdata->{'_Options'}});$i++) {
1153: my $option = $ORdata->{'_Options'}->[$i];
1154: if ($total_incorrect == 0) {
1155: push(@{$plotdata[$i+1]},0);
1156: } else {
1157: push(@{$plotdata[$i+1]},
1158: 100 * $processed_time_data->{$foil}->{$option} / $total_incorrect);
1159: }
1160: }
1161: }
1162: # Put in a blank one
1163: push(@labels,'');
1164: push(@{$plotdata[0]},0);
1165: for (my $i=0;$i<scalar(@{$ORdata->{'_Options'}});$i++) {
1166: push(@{$plotdata[$i+1]},0);
1167: }
1168: }
1169: #
1170: # Create the plot
1171: my $correct_plot = &Apache::loncommon::DrawBarGraph('Correct Statements',
1172: 'Statement Number',
1173: 'Percent Correct',
1174: 100,
1175: $plotcolors,
1176: undef,
1177: $plotdata[0]);
1178: for (my $j=0; $j< scalar(@{$plotdata[0]});$j++) {
1179: $plotdata[0]->[$j]=0;
1180: }
1181: my $incorrect_plot =
1182: &Apache::loncommon::DrawBarGraph('Incorrect Statements',
1183: 'Statement Number',
1184: 'Incorrect Option Choice',
1185: 100,
1186: $plotcolors,
1187: undef,
1188: @plotdata);
1189: return ($correct_plot,$incorrect_plot);
1190: }
1191:
1192: sub OR_Concept_Time_Analysis {
1193: my ($processed_time_data,$correct,$data_count,$student_count,
1194: $ORdata,$Concepts) = @_;
1195: return '' if ($data_count == 0);
1196: #
1197: # Put the data in plottable form
1198: my @plotdata;
1199: foreach my $concept (@$Concepts) {
1200: my ($total,$correct);
1201: foreach my $foil (@{$concept->{'foils'}}) {
1202: $total += $processed_time_data->{$foil}->{'_total'};
1203: $correct += $processed_time_data->{$foil}->{'_correct'};
1204: }
1205: if ($total == 0) {
1206: push(@plotdata,0);
1207: } else {
1208: push(@plotdata,100 * $correct / $total);
1209: }
1210: }
1211: #
1212: # Create the plot
1213: return &Apache::loncommon::DrawBarGraph('Correct Concepts',
1214: 'Concept Number',
1215: 'Percent Correct',
1216: 100,
1217: $plotcolors,
1218: undef,
1219: \@plotdata);
1220: }
1221:
1222: sub OR_time_process_data {
1223: my ($performance_data,$begin_index,$end_index)=@_;
1224: my %processed_time_data;
1225: my %distinct_students;
1226: my ($correct,$data_count);
1227: if (($begin_index == $end_index) &&
1228: ($end_index != scalar(@$performance_data)-1)) {
1229: return undef;
1230: }
1231: # Be sure we include the last one if we are asked for it.
1232: # That we have to correct here (and not when $end_index is
1233: # given a value) should probably be considered a bug.
1234: if ($end_index == scalar(@$performance_data)-1) {
1235: $end_index++;
1236: }
1237: &Apache::lonnet::logthis(' '.$begin_index.':'.$end_index);
1238: my $count;
1239: for (my $i=$begin_index;$i<$end_index;$i++) {
1240: my $attempt = $performance_data->[$i];
1241: $count++;
1242: next if (! defined($attempt));
1243: my %attempt = &Process_OR_Row($attempt);
1244: $data_count++;
1245: $correct += $attempt{'_correct'};
1246: $distinct_students{$attempt->[&Apache::loncoursedata::RD_student_id()]}++;
1247: while (my ($foilid,$href) = each(%attempt)) {
1248: if (! ref($href)) {
1249: $processed_time_data{$foilid} += $href;
1250: next;
1251: }
1252: while (my ($option,$value) = each(%$href)) {
1253: $processed_time_data{$foilid}->{$option}+=$value;
1254: }
1255: }
1256: }
1257: &Apache::lonnet::logthis('count = '.$count);
1258: return (\%processed_time_data,$correct,$data_count,
1259: scalar(keys(%distinct_students)));
1260: }
1261:
1262: #########################################################
1263: #########################################################
1264: ##
1265: ## Excel output
1266: ##
1267: #########################################################
1268: #########################################################
1269: sub OR_excel_sheet {
1270: my ($r,$resource,$performance_data,$ORdata) = @_;
1271: my $response = '';
1272: my (undef,$Foils,$Concepts) = &build_foil_index($ORdata);
1273: #
1274: # Create excel worksheet
1275: my $filename = '/prtspool/'.
1276: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
1277: time.'_'.rand(1000000000).'.xls';
1278: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1279: if (! defined($workbook)) {
1280: $r->log_error("Error creating excel spreadsheet $filename: $!");
1281: $r->print('<p>'.&mt("Unable to create new Excel file. ".
1282: "This error has been logged. ".
1283: "Please alert your LON-CAPA administrator").
1284: '</p>');
1285: return undef;
1286: }
1287: #
1288: $workbook->set_tempdir('/home/httpd/perl/tmp');
1289: my $format = &Apache::loncommon::define_excel_formats($workbook);
1290: #
1291: # Create and populate main worksheets
1292: my $problem_data_sheet = $workbook->addworksheet('Problem Data');
1293: my $student_data_sheet = &build_student_data_worksheet($workbook,$format);
1294: my $response_data_sheet = $workbook->addworksheet('Response Data');
1295: foreach my $sheet ($problem_data_sheet,$student_data_sheet,
1296: $response_data_sheet) {
1297: $sheet->write(0,0,$resource->{'title'},$format->{'h2'});
1298: $sheet->write(1,0,$resource->{'src'},$format->{'h3'});
1299: }
1300: #
1301: my $result;
1302: $result = &OR_build_problem_data_worksheet($problem_data_sheet,$format,
1303: $Concepts,$ORdata);
1304: if ($result ne 'okay') {
1305: # Do something useful
1306: }
1307: $result = &OR_build_response_data_worksheet($response_data_sheet,$format,
1308: $performance_data,$Foils,
1309: $ORdata);
1310: if ($result ne 'okay') {
1311: # Do something useful
1312: }
1313: $response_data_sheet->activate();
1314: #
1315: # Close the excel file
1316: $workbook->close();
1317: #
1318: # Write a link to allow them to download it
1319: $result .= '<h2>'.&mt('Excel Raw Data Output').'</h2>'.
1320: '<p><a href="'.$filename.'">'.
1321: &mt('Your Excel spreadsheet.').
1322: '</a></p>'."\n";
1323: return $result;
1324: }
1325:
1326: sub OR_build_problem_data_worksheet {
1327: my ($worksheet,$format,$Concepts,$ORdata) = @_;
1328: my $rows_output = 3;
1329: my $cols_output = 0;
1330: $worksheet->write($rows_output++,0,'Problem Structure',$format->{'h3'});
1331: ##
1332: ##
1333: my @Headers;
1334: if (@$Concepts > 1) {
1335: @Headers = ("Concept\nNumber",'Concept',"Foil\nNumber",
1336: 'Foil Name','Foil Text','Correct value');
1337: } else {
1338: @Headers = ('Foil Number','FoilName','Foil Text','Correct value');
1339: }
1340: $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
1341: my %Foildata = %{$ORdata->{'_Foils'}};
1342: my $conceptindex = 1;
1343: my $foilindex = 1;
1344: foreach my $concept (@$Concepts) {
1345: my @FoilsInConcept = @{$concept->{'foils'}};
1346: my $firstfoil = shift(@FoilsInConcept);
1347: if (@$Concepts > 1) {
1348: $worksheet->write_row($rows_output++,0,
1349: [$conceptindex,
1350: $concept->{'name'},
1351: $foilindex++,
1352: $Foildata{$firstfoil}->{'name'},
1353: $Foildata{$firstfoil}->{'text'},
1354: $Foildata{$firstfoil}->{'value'},]);
1355: } else {
1356: $worksheet->write_row($rows_output++,0,
1357: [ $foilindex++,
1358: $Foildata{$firstfoil}->{'name'},
1359: $Foildata{$firstfoil}->{'text'},
1360: $Foildata{$firstfoil}->{'value'},]);
1361: }
1362: foreach my $foilid (@FoilsInConcept) {
1363: if (@$Concepts > 1) {
1364: $worksheet->write_row($rows_output++,0,
1365: ['',
1366: '',
1367: $foilindex,
1368: $Foildata{$foilid}->{'name'},
1369: $Foildata{$foilid}->{'text'},
1370: $Foildata{$foilid}->{'value'},]);
1371: } else {
1372: $worksheet->write_row($rows_output++,0,
1373: [$foilindex,
1374: $Foildata{$foilid}->{'name'},
1375: $Foildata{$foilid}->{'text'},
1376: $Foildata{$foilid}->{'value'},]);
1377: }
1378: } continue {
1379: $foilindex++;
1380: }
1381: } continue {
1382: $conceptindex++;
1383: }
1384: $rows_output++;
1385: $rows_output++;
1386: ##
1387: ## Option data output
1388: $worksheet->write($rows_output++,0,'Options',$format->{'header'});
1389: foreach my $string (@{$ORdata->{'_Options'}}) {
1390: $worksheet->write($rows_output++,0,$string);
1391: }
1392: return 'okay';
1393: }
1394:
1395: sub OR_build_response_data_worksheet {
1396: my ($worksheet,$format,$performance_data,$Foils,$ORdata)=@_;
1397: my $rows_output = 3;
1398: my $cols_output = 0;
1399: $worksheet->write($rows_output++,0,'Response Data',$format->{'h3'});
1400: $worksheet->set_column(1,1,20);
1401: $worksheet->set_column(2,2,13);
1402: my @Headers = ('identifier','time','award detail','attempt');
1403: foreach my $foil (@$Foils) {
1404: push (@Headers,$foil.' submission');
1405: push (@Headers,$foil.' grading');
1406: }
1407: $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
1408: #
1409: foreach my $row (@$performance_data) {
1410: next if (! defined($row));
1411: my ($student,$award,$grading,$submission,$time,$tries) = @$row;
1412: my @Foilgrades = split('&',$grading);
1413: my @Foilsubs = split('&',$submission);
1414: my %response_data;
1415: for (my $j=0;$j<=$#Foilgrades;$j++) {
1416: my ($foilid,$correct) = split('=',$Foilgrades[$j]);
1417: my (undef,$submission) = split('=',$Foilsubs[$j]);
1418: $submission = &Apache::lonnet::unescape($submission);
1419: $response_data{$foilid.' submission'}=$submission;
1420: $response_data{$foilid.' award'}=$correct;
1421: }
1422: $worksheet->write($rows_output,$cols_output++,$student);
1423: $worksheet->write($rows_output,$cols_output++,
1424: &Apache::lonstathelpers::calc_serial($time),$format->{'date'});
1425: $worksheet->write($rows_output,$cols_output++,$award);
1426: $worksheet->write($rows_output,$cols_output++,$tries);
1427: foreach my $foilid (@$Foils) {
1428: $worksheet->write($rows_output,$cols_output++,
1429: $response_data{$foilid.' submission'});
1430: $worksheet->write($rows_output,$cols_output++,
1431: $response_data{$foilid.' award'});
1432: }
1433: $rows_output++;
1434: $cols_output = 0;
1435: }
1436: return;
1437: }
1438:
1439: sub build_foil_index {
1440: my ($ORdata) = @_;
1441: return if (! exists($ORdata->{'_Foils'}));
1442: my %Foildata = %{$ORdata->{'_Foils'}};
1443: my @Foils = sort(keys(%Foildata));
1444: my %Concepts;
1445: foreach my $foilid (@Foils) {
1446: push(@{$Concepts{$Foildata{$foilid}->{'_Concept'}}},
1447: $foilid);
1448: }
1449: undef(@Foils);
1450: # Having gathered the concept information in a hash, we now translate it
1451: # into an array because we need to be consistent about order.
1452: # Also put the foils in order, too.
1453: my $sortfunction = sub {
1454: my %Numbers = (one => 1,
1455: two => 2,
1456: three => 3,
1457: four => 4,
1458: five => 5,
1459: six => 6,
1460: seven => 7,
1461: eight => 8,
1462: nine => 9,
1463: ten => 10,);
1464: my $a1 = lc($a);
1465: my $b1 = lc($b);
1466: if (exists($Numbers{$a1})) {
1467: $a1 = $Numbers{$a1};
1468: }
1469: if (exists($Numbers{$b1})) {
1470: $b1 = $Numbers{$b1};
1471: }
1472: if (($a1 =~/^\d+$/) && ($b1 =~/^\d+$/)) {
1473: return $a1 <=> $b1;
1474: } else {
1475: return $a1 cmp $b1;
1476: }
1477: };
1478: my @Concepts;
1479: foreach my $concept (sort $sortfunction (keys(%Concepts))) {
1480: if (! defined($Concepts{$concept})) {
1481: $Concepts{$concept}=[];
1482: # next;
1483: }
1484: push(@Concepts,{ name => $concept,
1485: foils => [@{$Concepts{$concept}}]});
1486: push(@Foils,(@{$Concepts{$concept}}));
1487: }
1488: #
1489: # Build up the table of row labels.
1490: my $table = '<table border="1" >'."\n";
1491: if (@Concepts > 1) {
1492: $table .= '<tr>'.
1493: '<th>'.&mt('Concept Number').'</th>'.
1494: '<th>'.&mt('Concept').'</th>'.
1495: '<th>'.&mt('Foil Number').'</th>'.
1496: '<th>'.&mt('Foil Name').'</th>'.
1497: '<th>'.&mt('Foil Text').'</th>'.
1498: '<th>'.&mt('Correct Value').'</th>'.
1499: "</tr>\n";
1500: } else {
1501: $table .= '<tr>'.
1502: '<th>'.&mt('Foil Number').'</th>'.
1503: '<th>'.&mt('Foil Name').'</th>'.
1504: '<th>'.&mt('Foil Text').'</th>'.
1505: '<th>'.&mt('Correct Value').'</th>'.
1506: "</tr>\n";
1507: }
1508: my $conceptindex = 1;
1509: my $foilindex = 1;
1510: foreach my $concept (@Concepts) {
1511: my @FoilsInConcept = @{$concept->{'foils'}};
1512: my $firstfoil = shift(@FoilsInConcept);
1513: if (@Concepts > 1) {
1514: $table .= '<tr>'.
1515: '<td>'.$conceptindex.'</td>'.
1516: '<td>'.&HTML::Entities::encode($concept->{'name'},'<>&"').'</td>'.
1517: '<td>'.$foilindex++.'</td>'.
1518: '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').'</td>'.
1519: '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
1520: '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').'</td>'.
1521: "</tr>\n";
1522: } else {
1523: $table .= '<tr>'.
1524: '<td>'.$foilindex++.'</td>'.
1525: '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').'</td>'.
1526: '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
1527: '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').'</td>'.
1528: "</tr>\n";
1529: }
1530: foreach my $foilid (@FoilsInConcept) {
1531: if (@Concepts > 1) {
1532: $table .= '<tr>'.
1533: '<td></td>'.
1534: '<td></td>'.
1535: '<td>'.$foilindex.'</td>'.
1536: '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').'</td>'.
1537: '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
1538: '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'},'<>&"').'</td>'.
1539: "</tr>\n";
1540: } else {
1541: $table .= '<tr>'.
1542: '<td>'.$foilindex.'</td>'.
1543: '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').'</td>'.
1544: '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
1545: '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'},'<>&"').'</td>'.
1546: "</tr>\n";
1547: }
1548: } continue {
1549: $foilindex++;
1550: }
1551: } continue {
1552: $conceptindex++;
1553: }
1554: $table .= "</table>\n";
1555: #
1556: # Build option index with color stuff
1557: return ($table,\@Foils,\@Concepts);
1558: }
1559:
1560: sub build_option_index {
1561: my ($ORdata)= @_;
1562: my $table = "<table>\n";
1563: my $optionindex = 0;
1564: my @Rows;
1565: foreach my $option (&mt('correct option chosen'),@{$ORdata->{'_Options'}}) {
1566: my $color = $plotcolors->[$optionindex++];
1567: push (@Rows,
1568: '<tr>'.
1569: '<td bgcolor="'.$color.'">'.
1570: '<font color="'.$color.'">'.('*'x3).'</font>'.'</td>'.
1571: '<td>'.&HTML::Entities::encode($option,'<>&"').'</td>'.
1572: "</tr>\n");
1573: }
1574: shift(@Rows); # Throw away 'correct option chosen' color
1575: $table .= join('',reverse(@Rows));
1576: $table .= "</table>\n";
1577: }
1578:
1579: sub build_foil_key {
1580: my ($foils,$extra_data)= @_;
1581: if (! defined($extra_data)) { $extra_data = {}; }
1582: my $table = "<table>\n";
1583: my $foil_index = 0;
1584: my @rows;
1585: foreach my $foil (&mt('correct foil chosen'),@{$foils}) {
1586: my $color = $plotcolors->[$foil_index++];
1587: push (@rows,
1588: '<tr>'.
1589: '<td bgcolor="'.$color.'" class="key">'.
1590: '<font color="'.$color.'">'.('*'x4).'</font></td>'.
1591: '<td>'.&HTML::Entities::encode($foil,'<>&"').
1592: (' 'x2).$extra_data->{$foil}.'</td>'.
1593: "</tr>\n");
1594: }
1595: shift(@rows); # Throw away 'correct foil chosen' color
1596: $table .= join('',reverse(@rows));
1597: $table .= "</table>\n";
1598: }
1599:
1600: #########################################################
1601: #########################################################
1602: ##
1603: ## Generic Interface Routines
1604: ##
1605: #########################################################
1606: #########################################################
1607: sub CreateInterface {
1608: ##
1609: ## Environment variable initialization
1610: if (! exists$ENV{'form.AnalyzeOver'}) {
1611: $ENV{'form.AnalyzeOver'} = 'tries';
1612: }
1613: ##
1614: ## Build the menu
1615: my $Str = '';
1616: $Str .= &Apache::lonhtmlcommon::breadcrumbs
1617: (undef,'Detailed Problem Analysis');
1618: $Str .= '<table cellspacing="5">'."\n";
1619: $Str .= '<tr>';
1620: $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
1621: $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
1622: # $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
1623: $Str .= '<td align="center"> </td>';
1624: $Str .= '</tr>'."\n";
1625: ##
1626: ##
1627: $Str .= '<tr><td align="center">'."\n";
1628: $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
1629: $Str .= '</td>';
1630: #
1631: $Str .= '<td align="center">';
1632: $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
1633: $Str .= '</td>';
1634: #
1635: # $Str .= '<td align="center">';
1636: my $only_seq_with_assessments = sub {
1637: my $s=shift;
1638: if ($s->{'num_assess'} < 1) {
1639: return 0;
1640: } else {
1641: return 1;
1642: }
1643: };
1644: &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
1645: $only_seq_with_assessments);
1646: ##
1647: ##
1648: $Str .= '<td>';
1649: ##
1650: my $showprob_checkbox =
1651: '<input type="checkbox" name="show_prob" value="true" ';
1652: if ($ENV{'form.show_prob'} eq 'true') {
1653: $showprob_checkbox .= 'checked ';
1654: }
1655: $showprob_checkbox.= ' />';
1656: $Str.= '<nobr><label>'.
1657: &mt('Show problem [_1]',$showprob_checkbox).
1658: '</label></nobr><br />';
1659: ##
1660: my $analyze_selector = '<select name="AnalyzeOver" >';
1661: $analyze_selector .= '<option value="tries" ';
1662: if (! exists($ENV{'form.AnalyzeOver'}) ||
1663: $ENV{'form.AnalyzeOver'} eq 'tries'){
1664: # Default to tries
1665: $analyze_selector .= ' selected ';
1666: }
1667: $analyze_selector .= '>'.&mt('Tries').'</option>';
1668: $analyze_selector .= '<option value="time" ';
1669: $analyze_selector .= ' selected ' if ($ENV{'form.AnalyzeOver'} eq 'time');
1670: $analyze_selector .= '>'.&mt('Time').'</option>';
1671: $analyze_selector .= '</select>';
1672: $Str .= '<nobr><label>'.
1673: &mt('Analyze Over [_1] [_2]',
1674: $analyze_selector,
1675: &Apache::loncommon::help_open_topic('Analysis_Analyze_Over')).
1676: '</label></nobr><br />'.$/;
1677: ##
1678: my $numplots_selector = '<select name="NumPlots">';
1679: if (! exists($ENV{'form.NumPlots'})
1680: || $ENV{'form.NumPlots'} < 1
1681: || $ENV{'form.NumPlots'} > 20) {
1682: $ENV{'form.NumPlots'} = 5;
1683: }
1684: foreach my $i (1,2,3,4,5,6,7,8,10,15,20) {
1685: $numplots_selector .= '<option value="'.$i.'" ';
1686: if ($ENV{'form.NumPlots'} == $i) { $numplots_selector.=' selected '; }
1687: $numplots_selector .= '>'.$i.'</option>';
1688: }
1689: $numplots_selector .= '</select></nobr><br />';
1690: $Str .= '<nobr><label>'.&mt('Number of Plots [_1]',$numplots_selector).
1691: '</label></nobr>';
1692: ##
1693: $Str .= '<nobr><label>'.&mt('Status: [_1]',
1694: '<input type="text" '.
1695: 'name="stats_status" size="60" value="" />'
1696: ).
1697: '</label></nobr>';
1698: $Str .= '</td>';
1699: ##
1700: ##
1701: $Str .= '</tr>'."\n";
1702: $Str .= '</table>'."\n";
1703: return $Str;
1704: }
1705:
1706: #########################################################
1707: #########################################################
1708: ##
1709: ## Misc Option Response functions
1710: ##
1711: #########################################################
1712: #########################################################
1713: sub get_time_from_row {
1714: my ($row) = @_;
1715: if (ref($row)) {
1716: return $row->[&Apache::loncoursedata::RD_timestamp()];
1717: }
1718: return undef;
1719: }
1720:
1721: sub get_tries_from_row {
1722: my ($row) = @_;
1723: if (ref($row)) {
1724: return $row->[&Apache::loncoursedata::RD_tries()];
1725: }
1726: return undef;
1727: }
1728:
1729: sub hashify_attempt {
1730: my ($row) = @_;
1731: my %attempt;
1732: $attempt{'student'} = $row->[&Apache::loncoursedata::RD_sname()];
1733: $attempt{'tries'} = $row->[&Apache::loncoursedata::RD_tries()];
1734: $attempt{'submission'} = &Apache::lonnet::unescape($row->[&Apache::loncoursedata::RD_submission()]);
1735: $attempt{'award'} = $row->[&Apache::loncoursedata::RD_awarddetail()];
1736: $attempt{'timestamp'} = $row->[&Apache::loncoursedata::RD_timestamp()];
1737: return %attempt;
1738: }
1739:
1740: sub Process_OR_Row {
1741: my ($row) = @_;
1742: my %RowData;
1743: # my $student_id = $row->[&Apache::loncoursedata::RD_student_id()];
1744: my $award = $row->[&Apache::loncoursedata::RD_awarddetail()];
1745: my $grading = $row->[&Apache::loncoursedata::RD_response_eval()];
1746: my $submission = $row->[&Apache::loncoursedata::RD_submission()];
1747: my $time = $row->[&Apache::loncoursedata::RD_timestamp()];
1748: # my $tries = $row->[&Apache::loncoursedata::RD_tries()];
1749: return undef if ($award eq 'MISSING_ANSWER');
1750: if (&submission_is_correct($award)) {
1751: $RowData{'_correct'} = 1;
1752: }
1753: $RowData{'_total'} = 1;
1754: my @Foilgrades = split('&',$grading);
1755: my @Foilsubs = split('&',$submission);
1756: for (my $j=0;$j<=$#Foilgrades;$j++) {
1757: my ($foilid,$correct) = split('=',$Foilgrades[$j]);
1758: $foilid = &Apache::lonnet::unescape($foilid);
1759: my (undef,$submission) = split('=',$Foilsubs[$j]);
1760: if ($correct) {
1761: $RowData{$foilid}->{'_correct'}++;
1762: } else {
1763: $submission = &Apache::lonnet::unescape($submission);
1764: $RowData{$foilid}->{$submission}++;
1765: }
1766: $RowData{$foilid}->{'_total'}++;
1767: }
1768: return %RowData;
1769: }
1770:
1771: sub submission_is_correct {
1772: my ($award) = @_;
1773: if ($award =~ /(APPROX_ANS|EXACT_ANS)/) {
1774: return 1;
1775: } else {
1776: return 0;
1777: }
1778: }
1779:
1780: 1;
1781:
1782: __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