1: # The LearningOnline Network with CAPA
2: #
3: # $Id: lonproblemanalysis.pm,v 1.66 2004/02/13 18:25:57 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 HTML::Entities();
38: use Time::Local();
39: use Spreadsheet::WriteExcel();
40:
41: my $plotcolors = ['#33ff00',
42: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
43: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
44: ];
45:
46: my @SubmitButtons = ({ name => 'PrevProblemAnalysis',
47: text => 'Previous Problem' },
48: { name => 'ProblemAnalysis',
49: text => 'Analyze Problem Again' },
50: { name => 'NextProblemAnalysis',
51: text => 'Next Problem' },
52: { name => 'break'},
53: { name => 'ClearCache',
54: text => 'Clear Caches' },
55: { name => 'updatecaches',
56: text => 'Update Student Data' },
57: { name => 'SelectAnother',
58: text => 'Choose a different Problem' },
59: { name => 'ExcelOutput',
60: text => 'Produce Excel Output' });
61:
62:
63: sub BuildProblemAnalysisPage {
64: my ($r,$c)=@_;
65: #
66: my %Saveable_Parameters = ('Status' => 'scalar',
67: 'Section' => 'array',
68: 'NumPlots' => 'scalar',
69: 'AnalyzeAs' => 'scalar',
70: 'AnalyzeOver' => 'scalar',
71: );
72: &Apache::loncommon::store_course_settings('problem_analysis',
73: \%Saveable_Parameters);
74: &Apache::loncommon::restore_course_settings('problem_analysis',
75: \%Saveable_Parameters);
76: #
77: &Apache::lonstatistics::PrepareClasslist();
78: #
79: $r->print('<h2>'.&mt('Detailed Problem Analysis').'</h2>');
80: $r->print(&CreateInterface());
81: #
82: my @Students = @Apache::lonstatistics::Students;
83: #
84: if (@Students < 1) {
85: $r->print('<h2>There are no students in the sections selected</h2>');
86: }
87: #
88: &Apache::loncoursedata::clear_internal_caches();
89: if (exists($ENV{'form.ClearCache'}) ||
90: exists($ENV{'form.updatecaches'}) ||
91: (exists($ENV{'form.firstanalysis'}) &&
92: $ENV{'form.firstanalysis'} ne 'no')) {
93: &Apache::lonstatistics::Gather_Full_Student_Data($r);
94: }
95: if (! exists($ENV{'form.firstanalysis'})) {
96: $r->print('<input type="hidden" name="firstanalysis" value="yes" />');
97: } else {
98: $r->print('<input type="hidden" name="firstanalysis" value="no" />');
99: }
100: $r->rflush();
101: #
102: my $problem_types = '(option|radiobutton|numerical)';
103: if (exists($ENV{'form.problemchoice'}) &&
104: ! exists($ENV{'form.SelectAnother'})) {
105: foreach my $button (@SubmitButtons) {
106: if ($button->{'name'} eq 'break') {
107: $r->print("<br />\n");
108: } else {
109: $r->print('<input type="submit" name="'.$button->{'name'}.'" '.
110: 'value="'.&mt($button->{'text'}).'" />');
111: $r->print(' 'x5);
112: }
113: }
114: #
115: $r->print('<hr />');
116: $r->rflush();
117: #
118: # Determine which problem we are to analyze
119: my $current_problem = &Apache::lonstathelpers::get_target_from_id
120: ($ENV{'form.problemchoice'});
121: #
122: my ($prev,$curr,$next) =
123: &Apache::lonstathelpers::get_prev_curr_next($current_problem,
124: $problem_types,
125: 'response',
126: );
127: if (exists($ENV{'form.PrevProblemAnalysis'}) && defined($prev)) {
128: $current_problem = $prev;
129: } elsif (exists($ENV{'form.NextProblemAnalysis'}) && defined($next)) {
130: $current_problem = $next;
131: } else {
132: $current_problem = $curr;
133: }
134: #
135: # Store the current problem choice and send it out in the form
136: $ENV{'form.problemchoice'} =
137: &Apache::lonstathelpers::make_target_id($current_problem);
138: $r->print('<input type="hidden" name="problemchoice" value="'.
139: $ENV{'form.problemchoice'}.'" />');
140: #
141: if (! defined($current_problem->{'resource'})) {
142: $r->print('resource is undefined');
143: } else {
144: my $resource = $current_problem->{'resource'};
145: $r->print('<h1>'.$resource->{'title'}.'</h1>');
146: $r->print('<h3>'.$resource->{'src'}.'</h3>');
147: $r->print(&Apache::lonstathelpers::render_resource($resource));
148: $r->rflush();
149: my %Data = &get_problem_data($resource->{'src'});
150: my $ProblemData = $Data{$current_problem->{'part'}.
151: '.'.
152: $current_problem->{'respid'}};
153: if ($current_problem->{'resptype'} eq 'option') {
154: &OptionResponseAnalysis($r,$current_problem,
155: $ProblemData,
156: \@Students);
157: } elsif ($current_problem->{'resptype'} eq 'radiobutton') {
158: &RadioResponseAnalysis($r,$current_problem,
159: $ProblemData,
160: \@Students);
161: } elsif ($current_problem->{'resptype'} eq 'numerical') {
162: &NumericalResponseAnalysis($r,$current_problem,
163: $ProblemData,\@Students);
164: } else {
165: $r->print('<h2>This analysis is not supported</h2>');
166: }
167: }
168: $r->print('<hr />');
169: } else {
170: $r->print('<input type="submit" name="ProblemAnalysis" value="'.
171: &mt('Analyze Problem').'" />');
172: $r->print(' 'x5);
173: $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
174: $r->print(&Apache::lonstathelpers::ProblemSelector
175: ($problem_types));
176: }
177: }
178:
179: #########################################################
180: #########################################################
181: ##
182: ## Numerical Response Routines
183: ##
184: #########################################################
185: #########################################################
186: sub NumericalResponseAnalysis {
187: my ($r,$problem,$ProblemData,$Students) = @_;
188: my ($resource,$respid) = ($problem->{'resource'},
189: $problem->{'respid'});
190: my $analysis_html;
191: my $PerformanceData =
192: &Apache::loncoursedata::get_response_data
193: ($Students,$resource->{'symb'},$respid);
194: if (! defined($PerformanceData) ||
195: ref($PerformanceData) ne 'ARRAY' ) {
196: $analysis_html = '<h2>'.
197: &mt('There is no submission data for this resource').
198: '</h2>';
199: $r->print($analysis_html);
200: return;
201: }
202: my $Answers = &GetStudentAnswers($r,$problem,$Students);
203:
204: $r->print('<h2>This analysis is not yet supported</h2>');
205: }
206:
207: sub GetStudentAnswers {
208: my ($r,$problem,$Students) = @_;
209: my %Answers;
210: my ($resource,$partid,$respid) = ($problem->{'resource'},
211: $problem->{'part'},
212: $problem->{'respid'});
213: # Open progress window
214: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
215: ($r,'Student Answer Compilation Status',
216: 'Student Answer Compilation Progress', scalar(@$Students));
217: $r->print("<table>\n");
218: $r->rflush();
219: foreach my $student (@$Students) {
220: my $sname = $student->{'username'};
221: my $sdom = $student->{'domain'};
222: my $answer = analyze_problem_as_student($resource,
223: $sname,$sdom,
224: $partid,$respid);
225: $r->print('<tr>'.
226: '<td>'.$sname.'</td>'.
227: '<td>'.$sdom.'</td>'.
228: '<td>'.$answer.'</td>'.
229: '</tr>'."\n");
230: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
231: &mt('last student'));
232: $Answers{$sname.':'.$sdom}=$answer;
233: }
234: $r->print("</table>\n");
235: $r->rflush();
236: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
237: # close progress window
238: return \%Answers;
239: }
240:
241: #########################################################
242: #########################################################
243: ##
244: ## Radio Response Routines
245: ##
246: #########################################################
247: #########################################################
248: sub RadioResponseAnalysis {
249: my ($r,$problem,$ProblemData,$Students) = @_;
250: my ($resource,$respid) = ($problem->{'resource'},
251: $problem->{'respid'});
252: my $analysis_html;
253: my $PerformanceData =
254: &Apache::loncoursedata::get_response_data
255: ($Students,$resource->{'symb'},$respid);
256: if (! defined($PerformanceData) ||
257: ref($PerformanceData) ne 'ARRAY' ) {
258: $analysis_html = '<h2>'.
259: &mt('There is no submission data for this resource').
260: '</h2>';
261: $r->print($analysis_html);
262: return;
263: }
264: if (exists($ENV{'form.ExcelOutput'})) {
265: $analysis_html .= &RR_Excel_output($r,$problem->{'resource'},
266: $PerformanceData,$ProblemData);
267: } elsif ($ENV{'form.AnalyzeOver'} eq 'Tries') {
268: $analysis_html .= &RR_Tries_Analysis($r,$problem->{'resource'},
269: $PerformanceData,$ProblemData);
270: } elsif ($ENV{'form.AnalyzeOver'} eq 'Time') {
271: $analysis_html .= &RR_Time_Analysis($r,$problem->{'resource'},
272: $PerformanceData,$ProblemData);
273: } else {
274: $analysis_html .= '<h2>'.
275: &mt('The analysis you have selected is not supported at this time').
276: '</h2>';
277: }
278: $r->print($analysis_html);
279: }
280:
281: sub RR_Excel_output {
282: my ($r,$PerformanceData,$ProblemData) = @_;
283: return '<h1>No!</h1>';
284: }
285:
286: sub RR_Tries_Analysis {
287: my ($r,$resource,$PerformanceData,$ProblemData) = @_;
288: my $analysis_html;
289: my $mintries = 1;
290: my $maxtries = $ENV{'form.NumPlots'};
291: my ($table,$Foils,$Concepts) = &build_foil_index($ProblemData);
292: if ((! defined($Concepts)) || ((@$Concepts < 2) &&
293: ($ENV{'form.AnalyzeAs'} ne 'Foils'))) {
294: $table = '<h3>'.
295: &mt('Not enough data for concept analysis. '.
296: 'Performing Foil Analysis').
297: '</h3>'.$table;
298: $ENV{'form.AnalyzeAs'} = 'Foils';
299: }
300: $analysis_html .= $table;
301: my @TryData = &RR_tries_data_analysis($r,$PerformanceData);
302: # if ($ENV{'form.AnalyzeAs'} eq 'Foils') {
303: $analysis_html .= &RR_Tries_Foil_Analysis($mintries,$maxtries,$Foils,
304: \@TryData,$ProblemData);
305: # } else {
306: # $analysis_html = &RR_Tries_Concept_Analysis($mintries,$maxtries,
307: # $Concepts,
308: # \@TryData,
309: # $ProblemData);
310: # }
311: return $analysis_html;
312: }
313:
314: sub RR_tries_data_analysis {
315: my ($r,$Attempt_data) = @_;
316: my @TryData;
317: foreach my $attempt (@$Attempt_data) {
318: my %Attempt = &hashify_attempt($attempt);
319: my ($answer,undef) = split('=',$Attempt{'submission'});
320: $TryData[$Attempt{'tries'}]->{$answer}++;
321: }
322: return @TryData;
323: }
324:
325: sub RR_Time_Analysis {
326: my ($r,$PerformanceData,$ProblemData) = @_;
327: my $html;
328: return $html;
329: }
330:
331: sub RR_Tries_Foil_Analysis {
332: my ($min,$max,$Foils,$TryData,$ProblemData) = @_;
333: my $html;
334: #
335: # Compute the data neccessary to make the plots
336: for (my $try=$min;$try<=$max;$try++) {
337: my @PlotData_Correct;
338: my @PlotData_Incorrect;
339: next if ($try > scalar(@{$TryData}));
340: next if (! defined($TryData->[$try]));
341: my %DataSet = %{$TryData->[$try]};
342: my $total = 0;
343: foreach my $foilid (@$Foils) {
344: $total += $DataSet{$foilid};
345: }
346: foreach my $foilid (@$Foils) {
347: if ($total == 0) {
348: push (@PlotData_Correct,0);
349: push (@PlotData_Incorrect,0);
350: } else {
351: if ($ProblemData->{'_Foils'}->{$foilid}->{'value'} eq 'true') {
352: push (@PlotData_Correct,
353: int(100*$DataSet{$foilid}/$total));
354: push (@PlotData_Incorrect,0);
355: } else {
356: push (@PlotData_Correct,0);
357: push (@PlotData_Incorrect,
358: int(100*$DataSet{$foilid}/$total));
359: }
360: }
361: }
362: my $title='Attempt '.$try;
363: my $xlabel = $total.' Submissions';
364: $html.= &Apache::loncommon::DrawBarGraph($title,
365: $xlabel,
366: 'Percent Choosing',
367: 100,
368: ['#33ff00','#ff3300'],
369: undef,
370: \@PlotData_Correct,
371: \@PlotData_Incorrect);
372: }
373: return $html;
374: }
375:
376: sub RR_Tries_Concept_Analysis {
377: my ($min,$max,$Concepts,$ResponseData,$ProblemData) = @_;
378: my $html;
379: return $html;
380: }
381:
382: sub RR_Time_Foil_Analysis {
383: my ($min,$max,$Foils,$ResponseData,$ProblemData) = @_;
384: my $html;
385: return $html;
386: }
387:
388: sub RR_Time_Concept_Analysis {
389: my ($min,$max,$Concepts,$ResponseData,$ProblemData) = @_;
390: my $html;
391: return $html;
392: }
393:
394:
395: sub get_Radio_problem_data {
396: my ($url) = @_;
397: my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
398: (my $garbage,$Answ)=split('_HASH_REF__',$Answ,2);
399: my %Answer = &Apache::lonnet::str2hash($Answ);
400: my %Partdata;
401: foreach my $part (@{$Answer{'parts'}}) {
402: while (my($key,$value) = each(%Answer)) {
403: # if (ref($value) eq 'ARRAY') {
404: # &Apache::lonnet::logthis('is ref part:'.$part.' '.$key.'='.join(',',@$value));
405: # } else {
406: # &Apache::lonnet::logthis('notref part:'.$part.' '.$key.'='.$value);
407: # }
408: next if ($key !~ /^$part/);
409: $key =~ s/^$part\.//;
410: if ($key eq 'foils') {
411: $Partdata{$part}->{'_Foils'}=$value;
412: } elsif ($key eq 'options') {
413: $Partdata{$part}->{'_Options'}=$value;
414: } elsif ($key eq 'shown') {
415: $Partdata{$part}->{'_Shown'}=$value;
416: } elsif ($key =~ /^foil.value.(.*)$/) {
417: $Partdata{$part}->{$1}->{'value'}=$value;
418: } elsif ($key =~ /^foil.text.(.*)$/) {
419: $Partdata{$part}->{$1}->{'text'}=$value;
420: }
421: }
422: }
423: return %Partdata;
424: }
425:
426: #########################################################
427: #########################################################
428: ##
429: ## Option Response Routines
430: ##
431: #########################################################
432: #########################################################
433: sub OptionResponseAnalysis {
434: my ($r,$problem,$ProblemData,$Students) = @_;
435: my ($resource,$respid) = ($problem->{'resource'},
436: $problem->{'respid'});
437: # Note: part data is not needed.
438: my $PerformanceData =
439: &Apache::loncoursedata::get_response_data
440: ($Students,$resource->{'symb'},$respid);
441: if (! defined($PerformanceData) ||
442: ref($PerformanceData) ne 'ARRAY' ) {
443: $r->print('<h2>'.
444: &mt('There is no student data for this problem.').
445: '</h2>');
446: } else {
447: $r->rflush();
448: if (exists($ENV{'form.ExcelOutput'})) {
449: my $result = &OR_excel_sheet($r,$resource,
450: $PerformanceData,
451: $ProblemData);
452: $r->print($result);
453: $r->rflush();
454: } else {
455: if ($ENV{'form.AnalyzeOver'} eq 'Tries') {
456: my $analysis_html = &OR_tries_analysis($r,
457: $PerformanceData,
458: $ProblemData);
459: $r->print($analysis_html);
460: $r->rflush();
461: } elsif ($ENV{'form.AnalyzeOver'} eq 'Time') {
462: my $analysis_html = &OR_time_analysis($PerformanceData,
463: $ProblemData);
464: $r->print($analysis_html);
465: $r->rflush();
466: } else {
467: $r->print('<h2>'.
468: &mt('The analysis you have selected is '.
469: 'not supported at this time').
470: '</h2>');
471: }
472: }
473: }
474: }
475:
476: #########################################################
477: #
478: # Option Response: Tries Analysis
479: #
480: #########################################################
481: sub OR_tries_analysis {
482: my ($r,$PerformanceData,$ORdata) = @_;
483: my $mintries = 1;
484: my $maxtries = $ENV{'form.NumPlots'};
485: my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
486: if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) {
487: $table = '<h3>'.
488: &mt('Not enough data for concept analysis. '.
489: 'Performing Foil Analysis').
490: '</h3>'.$table;
491: $ENV{'form.AnalyzeAs'} = 'Foils';
492: }
493: my %ResponseData = &OR_analyze_by_tries($r,$PerformanceData,
494: $mintries,$maxtries);
495: my $analysis = '';
496: if ($ENV{'form.AnalyzeAs'} eq 'Foils') {
497: $analysis = &OR_Tries_Foil_Analysis($mintries,$maxtries,$Foils,
498: \%ResponseData,$ORdata);
499: } else {
500: $analysis = &OR_Tries_Concept_Analysis($mintries,$maxtries,
501: $Concepts,\%ResponseData,$ORdata);
502: }
503: $table .= $analysis;
504: return $table;
505: }
506:
507: sub OR_Tries_Foil_Analysis {
508: my ($mintries,$maxtries,$Foils,$respdat,$ORdata) = @_;
509: my %ResponseData = %$respdat;
510: #
511: # Compute the data neccessary to make the plots
512: my @PlotData;
513: foreach my $foilid (@$Foils) {
514: for (my $i=$mintries;$i<=$maxtries;$i++) {
515: if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) {
516: push(@{$PlotData[$i]->{'_correct'}},0);
517: } else {
518: push(@{$PlotData[$i]->{'_correct'}},
519: 100*$ResponseData{$foilid}->[$i]->{'_correct'}/
520: $ResponseData{$foilid}->[$i]->{'_total'});
521: }
522: foreach my $option (@{$ORdata->{'_Options'}}) {
523: push(@{$PlotData[$i]->{'_total'}},
524: $ResponseData{$foilid}->[$i]->{'_total'});
525: if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) {
526: push (@{$PlotData[$i]->{$option}},0);
527: } else {
528: if ($ResponseData{$foilid}->[$i]->{'_total'} ==
529: $ResponseData{$foilid}->[$i]->{'_correct'}) {
530: push(@{$PlotData[$i]->{$option}},0);
531: } else {
532: push (@{$PlotData[$i]->{$option}},
533: 100 * $ResponseData{$foilid}->[$i]->{$option} /
534: ($ResponseData{$foilid}->[$i]->{'_total'} -
535: $ResponseData{$foilid}->[$i]->{'_correct'}));
536: }
537: }
538: }
539: }
540: }
541: #
542: # Build a table for the plots
543: my $analysis_html = "<table>\n";
544: my $foilkey = &build_option_index($ORdata);
545: for (my $i=$mintries;$i<=$maxtries;$i++) {
546: my $count = $ResponseData{'_total'}->[$i];
547: if ($count == 0) {
548: $count = 'no submissions';
549: } elsif ($count == 1) {
550: $count = '1 submission';
551: } else {
552: $count = $count.' submissions';
553: }
554: my $title = 'Attempt '.$i.', '.$count;
555: my @Datasets;
556: foreach my $option ('_correct',@{$ORdata->{'_Options'}}) {
557: next if (! exists($PlotData[$i]->{$option}));
558: push(@Datasets,$PlotData[$i]->{$option});
559: }
560: my $correctgraph = &Apache::loncommon::DrawBarGraph
561: ($title,'Foil Number','Percent Correct',
562: 100,$plotcolors,undef,$Datasets[0]);
563: $analysis_html.= '<tr><td>'.$correctgraph.'</td>';
564: ##
565: ##
566: next if (! defined($Datasets[0]));
567: for (my $i=0; $i< scalar(@{$Datasets[0]});$i++) {
568: $Datasets[0]->[$i]=0;
569: }
570: $count = $ResponseData{'_total'}->[$i]-$ResponseData{'_correct'}->[$i];
571: if ($count == 0) {
572: $count = 'no submissions';
573: } elsif ($count == 1) {
574: $count = '1 submission';
575: } else {
576: $count = $count.' submissions';
577: }
578: $title = 'Attempt '.$i.', '.$count;
579: my $incorrectgraph = &Apache::loncommon::DrawBarGraph
580: ($title,'Foil Number','% Option Chosen Incorrectly',
581: 100,$plotcolors,undef,@Datasets);
582: $analysis_html.= '<td>'.$incorrectgraph.'</td>';
583: $analysis_html.= '<td>'.$foilkey."<td></tr>\n";
584: }
585: $analysis_html .= "</table>\n";
586: return $analysis_html;
587: }
588:
589: sub OR_Tries_Concept_Analysis {
590: my ($mintries,$maxtries,$Concepts,$respdat,$ORdata) = @_;
591: my %ResponseData = %$respdat;
592: my $analysis_html = "<table>\n";
593: #
594: # Compute the data neccessary to make the plots
595: my @PlotData;
596: # Concept analysis
597: #
598: # Note: we do not bother with characterizing the students incorrect
599: # answers at the concept level because an incorrect answer for one foil
600: # may be a correct answer for another foil.
601: my %ConceptData;
602: foreach my $concept (@{$Concepts}) {
603: for (my $i=$mintries;$i<=$maxtries;$i++) {
604: #
605: # Gather the per-attempt data
606: my $cdata = $ConceptData{$concept}->[$i];
607: foreach my $foilid (@{$concept->{'foils'}}) {
608: $cdata->{'_correct'} +=
609: $ResponseData{$foilid}->[$i]->{'_correct'};
610: $cdata->{'_total'} +=
611: $ResponseData{$foilid}->[$i]->{'_total'};
612: }
613: push (@{$PlotData[$i]->{'_total'}},$cdata->{'_total'});
614: if ($cdata->{'_total'} == 0) {
615: push (@{$PlotData[$i]->{'_correct'}},0);
616: } else {
617: push (@{$PlotData[$i]->{'_correct'}},
618: 100*$cdata->{'_correct'}/$cdata->{'_total'});
619: }
620: }
621: }
622: # Build a table for the plots
623: for (my $i=$mintries;$i<=$maxtries;$i++) {
624: my $minstu = $PlotData[$i]->{'_total'}->[0];
625: my $maxstu = $PlotData[$i]->{'_total'}->[0];
626: foreach my $count (@{$PlotData[$i]->{'_total'}}) {
627: if ($minstu > $count) {
628: $minstu = $count;
629: }
630: if ($maxstu < $count) {
631: $maxstu = $count;
632: }
633: }
634: $maxstu = 0 if (! defined($maxstu));
635: $minstu = 0 if (! defined($minstu));
636: my $title;
637: my $count = $ResponseData{'_total'}->[$i];
638: if ($count == 0) {
639: $count = 'no submissions';
640: } elsif ($count == 1) {
641: $count = '1 submission';
642: } else {
643: $count = $count.' submissions';
644: }
645: $title = 'Attempt '.$i.', '.$count;
646: my $graphlink = &Apache::loncommon::DrawBarGraph
647: ($title,'Concept Number','Percent Correct',
648: 100,$plotcolors,undef,$PlotData[$i]->{'_correct'});
649: $analysis_html.= '<tr><td>'.$graphlink."</td></tr>\n";
650: }
651: $analysis_html .= "</table>\n";
652: return $analysis_html;
653: }
654:
655: sub OR_analyze_by_tries {
656: my ($r,$PerformanceData,$mintries,$maxtries) = @_;
657: my %Trydata;
658: $mintries = 1 if (! defined($mintries) || $mintries < 1);
659: $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
660: foreach my $row (@$PerformanceData) {
661: next if (! defined($row));
662: my $tries = &get_tries_from_row($row);
663: my %Row = &Process_OR_Row($row);
664: next if (! %Row);
665: while (my ($foilid,$href) = each(%Row)) {
666: if (! ref($href)) {
667: $Trydata{$foilid}->[$tries] += $href;
668: next;
669: }
670: while (my ($option,$value) = each(%$href)) {
671: $Trydata{$foilid}->[$tries]->{$option}+=$value;
672: }
673: }
674: }
675: return %Trydata;
676: }
677:
678: #########################################################
679: #
680: # Option Response: Time Analysis
681: #
682: #########################################################
683: sub OR_time_analysis {
684: my ($PerformanceData,$ORdata) = @_;
685: my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
686: if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) {
687: $table = '<h3>'.
688: &mt('Not enough data for concept analysis. '.
689: 'Performing Foil Analysis').
690: '</h3>'.$table;
691: $ENV{'form.AnalyzeAs'} = 'Foils';
692: }
693: my $num_plots = $ENV{'form.NumPlots'};
694: my $num_data = scalar(@$PerformanceData)-1;
695: my $percent = sprintf('%2f',100/$num_plots);
696: #
697: $table .= "<table>\n";
698: for (my $i=0;$i<$num_plots;$i++) {
699: ##
700: my $starttime = &Apache::lonhtmlcommon::get_date_from_form
701: ('startdate_'.$i);
702: my $endtime = &Apache::lonhtmlcommon::get_date_from_form
703: ('enddate_'.$i);
704: if (! defined($starttime) || ! defined($endtime)) {
705: my $sec_in_day = 86400;
706: my $last_sub_time = &get_time_from_row($PerformanceData->[-1]);
707: my ($sday,$smon,$syear);
708: (undef,undef,undef,$sday,$smon,$syear) =
709: localtime($last_sub_time - $sec_in_day*$i);
710: $starttime = &Time::Local::timelocal(0,0,0,$sday,$smon,$syear);
711: $endtime = $starttime + $sec_in_day;
712: if ($i == ($num_plots -1 )) {
713: $starttime = &get_time_from_row($PerformanceData->[0]);
714: }
715: }
716: my $startdateform = &Apache::lonhtmlcommon::date_setter
717: ('Statistics','startdate_'.$i,$starttime);
718: my $enddateform = &Apache::lonhtmlcommon::date_setter
719: ('Statistics','enddate_'.$i,$endtime);
720: #
721: my $begin_index;
722: my $end_index;
723: my $j;
724: while (++$j < scalar(@$PerformanceData)) {
725: last if (&get_time_from_row($PerformanceData->[$j])
726: > $starttime);
727: }
728: $begin_index = $j;
729: while (++$j < scalar(@$PerformanceData)) {
730: last if (&get_time_from_row($PerformanceData->[$j]) > $endtime);
731: }
732: $end_index = $j;
733: ##
734: my $interval = {
735: begin_index => $begin_index,
736: end_index => $end_index,
737: startdateform => $startdateform,
738: enddateform => $enddateform,
739: };
740: if ($ENV{'form.AnalyzeAs'} eq 'Foils') {
741: $table .= &OR_Foil_Time_Analysis($PerformanceData,$ORdata,$Foils,
742: $interval);
743: } else {
744: $table .= &OR_Concept_Time_Analysis($PerformanceData,$ORdata,
745: $Concepts,$interval);
746: }
747: }
748: #
749: return $table;
750: }
751:
752: sub OR_Foil_Time_Analysis {
753: my ($PerformanceData,$ORdata,$Foils,$interval) = @_;
754: my $analysis_html;
755: my $foilkey = &build_option_index($ORdata);
756: my ($begin_index,$end_index) = ($interval->{'begin_index'},
757: $interval->{'end_index'});
758: my %TimeData;
759: #
760: # Compute the number getting the foils correct or incorrects
761: for (my $j=$begin_index;$j<=$end_index;$j++) {
762: my $row = $PerformanceData->[$j];
763: next if (! defined($row));
764: my %Row = &Process_OR_Row($row);
765: while (my ($foilid,$href) = each(%Row)) {
766: if (! ref($href)) {
767: $TimeData{$foilid} += $href;
768: next;
769: }
770: while (my ($option,$value) = each(%$href)) {
771: $TimeData{$foilid}->{$option}+=$value;
772: }
773: }
774: }
775: my @Plotdata;
776: foreach my $foil (@$Foils) {
777: my $total = $TimeData{$foil}->{'_total'};
778: if ($total == 0) {
779: push(@{$Plotdata[0]},0);
780: } else {
781: push(@{$Plotdata[0]},
782: 100 * $TimeData{$foil}->{'_correct'} / $total);
783: }
784: my $total_incorrect = $total - $TimeData{$foil}->{'_correct'};
785: my $optionidx = 1;
786: foreach my $option (@{$ORdata->{'_Options'}}) {
787: if ($total_incorrect == 0) {
788: push(@{$Plotdata[$optionidx]},0);
789: } else {
790: push(@{$Plotdata[$optionidx]},
791: 100 * $TimeData{$foil}->{$option} / $total_incorrect);
792: }
793: } continue {
794: $optionidx++;
795: }
796: }
797: #
798: # Create the plot
799: my $count = $end_index-$begin_index;
800: my $title;
801: if ($count == 0) {
802: $title = 'no submissions';
803: } elsif ($count == 1) {
804: $title = 'one submission';
805: } else {
806: $title = $count.' submissions';
807: }
808: my $correctplot = &Apache::loncommon::DrawBarGraph($title,
809: 'Foil Number',
810: 'Percent Correct',
811: 100,
812: $plotcolors,
813: undef,
814: $Plotdata[0]);
815: for (my $j=0; $j< scalar(@{$Plotdata[0]});$j++) {
816: $Plotdata[0]->[$j]=0;
817: }
818: $count = $end_index-$begin_index-$TimeData{'_correct'};
819: if ($count == 0) {
820: $title = 'no submissions';
821: } elsif ($count == 1) {
822: $title = 'one submission';
823: } else {
824: $title = $count.' submissions';
825: }
826: my $incorrectplot = &Apache::loncommon::DrawBarGraph($title,
827: 'Foil Number',
828: 'Incorrect Option Choice',
829: 100,
830: $plotcolors,
831: undef,
832: @Plotdata);
833: $analysis_html.='<tr>'.
834: '<td>'.$correctplot.'</td>'.
835: '<td>'.$incorrectplot.'</td>'.
836: '<td align="left" valign="top">'.$foilkey.'</td>'."</tr>\n";
837: $analysis_html.= '<tr>'.'<td colspan="3">'.
838: '<b>Start Time</b>:'.
839: ' '.$interval->{'startdateform'}.'<br />'.
840: '<b>End Time</b> : '.
841: ' '.$interval->{'enddateform'}.'<br />'.
842: # '<b>Plot Title</b> :'.
843: # (" "x3).$interval->{'titleform'}.
844: '</td>'.
845: "</tr>\n";
846: return $analysis_html;
847: }
848:
849: sub OR_Concept_Time_Analysis {
850: my ($PerformanceData,$ORdata,$Concepts,$interval) = @_;
851: my $analysis_html;
852: ##
853: ## Determine starttime, endtime, startindex, endindex
854: my ($begin_index,$end_index) = ($interval->{'begin_index'},
855: $interval->{'end_index'});
856: my %TimeData;
857: #
858: # Compute the number getting the foils correct or incorrects
859: for (my $j=$begin_index;$j<=$end_index;$j++) {
860: my $row = $PerformanceData->[$j];
861: next if (! defined($row));
862: my %Row = &Process_OR_Row($row);
863: while (my ($foilid,$href) = each(%Row)) {
864: if (! ref($href)) {
865: $TimeData{$foilid} += $href;
866: next;
867: }
868: while (my ($option,$value) = each(%$href)) {
869: $TimeData{$foilid}->{$option}+=$value;
870: }
871: }
872: }
873: #
874: # Put the data in plottable form
875: my @Plotdata;
876: foreach my $concept (@$Concepts) {
877: my ($total,$correct);
878: foreach my $foil (@{$concept->{'foils'}}) {
879: $total += $TimeData{$foil}->{'_total'};
880: $correct += $TimeData{$foil}->{'_correct'};
881: }
882: if ($total == 0) {
883: push(@Plotdata,0);
884: } else {
885: push(@Plotdata,100 * $correct / $total);
886: }
887: }
888: #
889: # Create the plot
890: my $title = ($end_index - $begin_index).' submissions';
891: my $correctplot = &Apache::loncommon::DrawBarGraph($title,
892: 'Concept Number',
893: 'Percent Correct',
894: 100,
895: $plotcolors,
896: undef,
897: \@Plotdata);
898: $analysis_html.='<tr>'.
899: '<td>'.$correctplot.'</td>'.
900: '<td align="left" valign="top">'.
901: '<b>Start Time</b>: '.$interval->{'startdateform'}.'<br />'.
902: '<b>End Time</b> : '.
903: ' '.$interval->{'enddateform'}.'<br />'.
904: # '<b>Plot Title</b> :'.(" "x3).
905: # $interval->{'titleform'}.
906: '</td>'.
907: "</tr>\n";
908: return $analysis_html;
909: }
910:
911: #########################################################
912: #########################################################
913: ##
914: ## Excel output
915: ##
916: #########################################################
917: #########################################################
918: sub OR_excel_sheet {
919: my ($r,$resource,$PerformanceData,$ORdata) = @_;
920: my $response = '';
921: my (undef,$Foils,$Concepts) = &build_foil_index($ORdata);
922: #
923: # Create excel worksheet
924: my $filename = '/prtspool/'.
925: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
926: time.'_'.rand(1000000000).'.xls';
927: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
928: if (! defined($workbook)) {
929: $r->log_error("Error creating excel spreadsheet $filename: $!");
930: $r->print('<p>'.&mt("Unable to create new Excel file. ".
931: "This error has been logged. ".
932: "Please alert your LON-CAPA administrator").
933: '</p>');
934: return undef;
935: }
936: #
937: $workbook->set_tempdir('/home/httpd/perl/tmp');
938: #
939: # Define some potentially useful formats
940: my $format;
941: $format->{'header'} = $workbook->add_format(bold => 1,
942: bottom => 1,
943: align => 'center');
944: $format->{'bold'} = $workbook->add_format(bold=>1);
945: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
946: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
947: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
948: $format->{'date'} = $workbook->add_format(num_format=>
949: 'mmm d yyyy hh:mm AM/PM');
950: #
951: # Create and populate main worksheets
952: my $problem_data_sheet = $workbook->addworksheet('Problem Data');
953: my $student_data_sheet = $workbook->addworksheet('Student Data');
954: my $response_data_sheet = $workbook->addworksheet('Response Data');
955: foreach my $sheet ($problem_data_sheet,$student_data_sheet,
956: $response_data_sheet) {
957: $sheet->write(0,0,$resource->{'title'},$format->{'h2'});
958: $sheet->write(1,0,$resource->{'src'},$format->{'h3'});
959: }
960: #
961: my $result;
962: $result = &OR_build_problem_data_worksheet($problem_data_sheet,$format,
963: $Concepts,$ORdata);
964: if ($result ne 'okay') {
965: # Do something useful
966: }
967: $result = &OR_build_student_data_worksheet($student_data_sheet,$format);
968: if ($result ne 'okay') {
969: # Do something useful
970: }
971: $result = &OR_build_response_data_worksheet($response_data_sheet,$format,
972: $PerformanceData,$Foils,
973: $ORdata);
974: if ($result ne 'okay') {
975: # Do something useful
976: }
977: $response_data_sheet->activate();
978: #
979: # Close the excel file
980: $workbook->close();
981: #
982: # Write a link to allow them to download it
983: $result .= '<h2>'.&mt('Excel Raw Data Output').'</h2>'.
984: '<p><a href="'.$filename.'">'.
985: &mt('Your Excel spreadsheet.').
986: '</a></p>'."\n";
987: return $result;
988: }
989:
990: sub OR_build_problem_data_worksheet {
991: my ($worksheet,$format,$Concepts,$ORdata) = @_;
992: my $rows_output = 3;
993: my $cols_output = 0;
994: $worksheet->write($rows_output++,0,'Problem Structure',$format->{'h3'});
995: ##
996: ##
997: my @Headers;
998: if (@$Concepts > 1) {
999: @Headers = ("Concept\nNumber",'Concept',"Foil\nNumber",
1000: 'Foil Name','Foil Text','Correct value');
1001: } else {
1002: @Headers = ('Foil Number','FoilName','Foil Text','Correct value');
1003: }
1004: $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
1005: my %Foildata = %{$ORdata->{'_Foils'}};
1006: my $conceptindex = 1;
1007: my $foilindex = 1;
1008: foreach my $concept (@$Concepts) {
1009: my @FoilsInConcept = @{$concept->{'foils'}};
1010: my $firstfoil = shift(@FoilsInConcept);
1011: if (@$Concepts > 1) {
1012: $worksheet->write_row($rows_output++,0,
1013: [$conceptindex,
1014: $concept->{'name'},
1015: $foilindex++,
1016: $Foildata{$firstfoil}->{'name'},
1017: $Foildata{$firstfoil}->{'text'},
1018: $Foildata{$firstfoil}->{'value'},]);
1019: } else {
1020: $worksheet->write_row($rows_output++,0,
1021: [ $foilindex++,
1022: $Foildata{$firstfoil}->{'name'},
1023: $Foildata{$firstfoil}->{'text'},
1024: $Foildata{$firstfoil}->{'value'},]);
1025: }
1026: foreach my $foilid (@FoilsInConcept) {
1027: if (@$Concepts > 1) {
1028: $worksheet->write_row($rows_output++,0,
1029: ['',
1030: '',
1031: $foilindex,
1032: $Foildata{$foilid}->{'name'},
1033: $Foildata{$foilid}->{'text'},
1034: $Foildata{$foilid}->{'value'},]);
1035: } else {
1036: $worksheet->write_row($rows_output++,0,
1037: [$foilindex,
1038: $Foildata{$foilid}->{'name'},
1039: $Foildata{$foilid}->{'text'},
1040: $Foildata{$foilid}->{'value'},]);
1041: }
1042: } continue {
1043: $foilindex++;
1044: }
1045: } continue {
1046: $conceptindex++;
1047: }
1048: $rows_output++;
1049: $rows_output++;
1050: ##
1051: ## Option data output
1052: $worksheet->write($rows_output++,0,'Options',$format->{'header'});
1053: foreach my $string (@{$ORdata->{'_Options'}}) {
1054: $worksheet->write($rows_output++,0,$string);
1055: }
1056: return 'okay';
1057: }
1058:
1059: sub OR_build_student_data_worksheet {
1060: my ($worksheet,$format) = @_;
1061: my $rows_output = 3;
1062: my $cols_output = 0;
1063: $worksheet->write($rows_output++,0,'Student Data',$format->{'h3'});
1064: my @Headers = ('full name','username','domain','section',
1065: "student\nnumber",'identifier');
1066: $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
1067: my @Students = @Apache::lonstatistics::Students;
1068: my $studentrows = &Apache::loncoursedata::get_student_data(\@Students);
1069: my %ids;
1070: foreach my $row (@$studentrows) {
1071: my ($mysqlid,$student) = @$row;
1072: $ids{$student}=$mysqlid;
1073: }
1074: foreach my $student (@Students) {
1075: my $name_domain = $student->{'username'}.':'.$student->{'domain'};
1076: $worksheet->write_row($rows_output++,0,
1077: [$student->{'fullname'},
1078: $student->{'username'},$student->{'domain'},
1079: $student->{'section'},$student->{'id'},
1080: $ids{$name_domain}]);
1081: }
1082: return;
1083: }
1084:
1085: sub OR_build_response_data_worksheet {
1086: my ($worksheet,$format,$PerformanceData,$Foils,$ORdata)=@_;
1087: my $rows_output = 3;
1088: my $cols_output = 0;
1089: $worksheet->write($rows_output++,0,'Response Data',$format->{'h3'});
1090: $worksheet->set_column(1,1,20);
1091: $worksheet->set_column(2,2,13);
1092: my @Headers = ('identifier','time','award detail','attempt');
1093: foreach my $foil (@$Foils) {
1094: push (@Headers,$foil.' submission');
1095: push (@Headers,$foil.' grading');
1096: }
1097: $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
1098: #
1099: foreach my $row (@$PerformanceData) {
1100: next if (! defined($row));
1101: my ($student,$award,$grading,$submission,$time,$tries) = @$row;
1102: my @Foilgrades = split('&',$grading);
1103: my @Foilsubs = split('&',$submission);
1104: my %ResponseData;
1105: for (my $j=0;$j<=$#Foilgrades;$j++) {
1106: my ($foilid,$correct) = split('=',$Foilgrades[$j]);
1107: my (undef,$submission) = split('=',$Foilsubs[$j]);
1108: $submission = &Apache::lonnet::unescape($submission);
1109: $ResponseData{$foilid.' submission'}=$submission;
1110: $ResponseData{$foilid.' award'}=$correct;
1111: }
1112: $worksheet->write($rows_output,$cols_output++,$student);
1113: $worksheet->write($rows_output,$cols_output++,
1114: &calc_serial($time),$format->{'date'});
1115: $worksheet->write($rows_output,$cols_output++,$award);
1116: $worksheet->write($rows_output,$cols_output++,$tries);
1117: foreach my $foilid (@$Foils) {
1118: $worksheet->write($rows_output,$cols_output++,
1119: $ResponseData{$foilid.' submission'});
1120: $worksheet->write($rows_output,$cols_output++,
1121: $ResponseData{$foilid.' award'});
1122: }
1123: $rows_output++;
1124: $cols_output = 0;
1125: }
1126: return;
1127: }
1128:
1129:
1130: ##
1131: ## The following is copied from datecalc1.pl, part of the
1132: ## Spreadsheet::WriteExcel CPAN module.
1133: ##
1134: ##
1135: ######################################################################
1136: #
1137: # Demonstration of writing date/time cells to Excel spreadsheets,
1138: # using UNIX/Perl time as source of date/time.
1139: #
1140: # Copyright 2000, Andrew Benham, adsb@bigfoot.com
1141: #
1142: ######################################################################
1143: #
1144: # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970)
1145: # measured in seconds.
1146: #
1147: # An Excel file can use exactly one of two different date/time systems.
1148: # In these systems, a floating point number represents the number of days
1149: # (and fractional parts of the day) since a start point. The floating point
1150: # number is referred to as a 'serial'.
1151: # The two systems ('1900' and '1904') use different starting points:
1152: # '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as
1153: # a leap year - see:
1154: # http://support.microsoft.com/support/kb/articles/Q181/3/70.asp
1155: # for the excuse^H^H^H^H^H^Hreason.
1156: # '1904'; '1.00' is 2 Jan 1904.
1157: #
1158: # The '1904' system is the default for Apple Macs. Windows versions of
1159: # Excel have the option to use the '1904' system.
1160: #
1161: # Note that Visual Basic's "DateSerial" function does NOT erroneously
1162: # regard 1900 as a leap year, and thus its serials do not agree with
1163: # the 1900 serials of Excel for dates before 1 Mar 1900.
1164: #
1165: # Note that StarOffice (at least at version 5.2) does NOT erroneously
1166: # regard 1900 as a leap year, and thus its serials do not agree with
1167: # the 1900 serials of Excel for dates before 1 Mar 1900.
1168: #
1169: ######################################################################
1170: #
1171: # Calculation description
1172: # =======================
1173: #
1174: # 1900 system
1175: # -----------
1176: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900.
1177: # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
1178: # were leap years with an extra day.
1179: # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and
1180: # 1 Jan 1970.
1181: # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year
1182: # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'.
1183: #
1184: # 1904 system
1185: # -----------
1186: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904.
1187: # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
1188: # were leap years with an extra day.
1189: # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and
1190: # 1 Jan 1970.
1191: # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'.
1192: #
1193: ######################################################################
1194: #
1195: # Copyright (c) 2000, Andrew Benham.
1196: # This program is free software. It may be used, redistributed and/or
1197: # modified under the same terms as Perl itself.
1198: #
1199: # Andrew Benham, adsb@bigfoot.com
1200: # London, United Kingdom
1201: # 11 Nov 2000
1202: #
1203: ######################################################################
1204:
1205: # Use 1900 date system on all platforms other than Apple Mac (for which
1206: # use 1904 date system).
1207: my $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0;
1208:
1209: #-----------------------------------------------------------
1210: # calc_serial()
1211: #
1212: # Called with (up to) 2 parameters.
1213: # 1. Unix timestamp. If omitted, uses current time.
1214: # 2. GMT flag. Set to '1' to return serial in GMT.
1215: # If omitted, returns serial in appropriate timezone.
1216: #
1217: # Returns date/time serial according to $DATE_SYSTEM selected
1218: #-----------------------------------------------------------
1219: sub calc_serial {
1220: my $time = (defined $_[0]) ? $_[0] : time();
1221: my $gmtflag = (defined $_[1]) ? $_[1] : 0;
1222:
1223: # Divide timestamp by number of seconds in a day.
1224: # This gives a date serial with '0' on 1 Jan 1970.
1225: my $serial = $time / 86400;
1226:
1227: # Adjust the date serial by the offset appropriate to the
1228: # currently selected system (1900/1904).
1229: if ($DATE_SYSTEM == 0) { # use 1900 system
1230: $serial += 25569;
1231: } else { # use 1904 system
1232: $serial += 24107;
1233: }
1234:
1235: unless ($gmtflag) {
1236: # Now have a 'raw' serial with the right offset. But this
1237: # gives a serial in GMT, which is false unless the timezone
1238: # is GMT. We need to adjust the serial by the appropriate
1239: # timezone offset.
1240: # Calculate the appropriate timezone offset by seeing what
1241: # the differences between localtime and gmtime for the given
1242: # time are.
1243:
1244: my @gmtime = gmtime($time);
1245: my @ltime = localtime($time);
1246:
1247: # For the first 7 elements of the two arrays, adjust the
1248: # date serial where the elements differ.
1249: for (0 .. 6) {
1250: my $diff = $ltime[$_] - $gmtime[$_];
1251: if ($diff) {
1252: $serial += _adjustment($diff,$_);
1253: }
1254: }
1255: }
1256:
1257: # Perpetuate the error that 1900 was a leap year by decrementing
1258: # the serial if we're using the 1900 system and the date is prior to
1259: # 1 Mar 1900. This has the effect of making serial value '60'
1260: # 29 Feb 1900.
1261:
1262: # This fix only has any effect if UNIX/Perl time on the platform
1263: # can represent 1900. Many can't.
1264:
1265: unless ($DATE_SYSTEM) {
1266: $serial-- if ($serial < 61); # '61' is 1 Mar 1900
1267: }
1268: return $serial;
1269: }
1270:
1271: sub _adjustment {
1272: # Based on the difference in the localtime/gmtime array elements
1273: # number, return the adjustment required to the serial.
1274:
1275: # We only look at some elements of the localtime/gmtime arrays:
1276: # seconds unlikely to be different as all known timezones
1277: # have an offset of integral multiples of 15 minutes,
1278: # but it's easy to do.
1279: # minutes will be different for timezone offsets which are
1280: # not an exact number of hours.
1281: # hours very likely to be different.
1282: # weekday will differ when localtime/gmtime difference
1283: # straddles midnight.
1284: #
1285: # Assume that difference between localtime and gmtime is less than
1286: # 5 days, then don't have to do maths for day of month, month number,
1287: # year number, etc...
1288:
1289: my ($delta,$element) = @_;
1290: my $adjust = 0;
1291:
1292: if ($element == 0) { # Seconds
1293: $adjust = $delta/86400; # 60 * 60 * 24
1294: } elsif ($element == 1) { # Minutes
1295: $adjust = $delta/1440; # 60 * 24
1296: } elsif ($element == 2) { # Hours
1297: $adjust = $delta/24; # 24
1298: } elsif ($element == 6) { # Day of week number
1299: # Catch difference straddling Sat/Sun in either direction
1300: $delta += 7 if ($delta < -4);
1301: $delta -= 7 if ($delta > 4);
1302:
1303: $adjust = $delta;
1304: }
1305: return $adjust;
1306: }
1307:
1308: sub build_foil_index {
1309: my ($ORdata) = @_;
1310: return if (! exists($ORdata->{'_Foils'}));
1311: my %Foildata = %{$ORdata->{'_Foils'}};
1312: my @Foils = sort(keys(%Foildata));
1313: my %Concepts;
1314: foreach my $foilid (@Foils) {
1315: push(@{$Concepts{$Foildata{$foilid}->{'_Concept'}}},
1316: $foilid);
1317: }
1318: undef(@Foils);
1319: # Having gathered the concept information in a hash, we now translate it
1320: # into an array because we need to be consistent about order.
1321: # Also put the foils in order, too.
1322: my $sortfunction = sub {
1323: my %Numbers = (one => 1,
1324: two => 2,
1325: three => 3,
1326: four => 4,
1327: five => 5,
1328: six => 6,
1329: seven => 7,
1330: eight => 8,
1331: nine => 9,
1332: ten => 10,);
1333: my $a1 = lc($a);
1334: my $b1 = lc($b);
1335: if (exists($Numbers{$a1})) {
1336: $a = $Numbers{$a1};
1337: }
1338: if (exists($Numbers{$b1})) {
1339: $b = $Numbers{$b1};
1340: }
1341: if (($a =~/^\d+$/) && ($b =~/^\d+$/)) {
1342: return $a <=> $b;
1343: } else {
1344: return $a cmp $b;
1345: }
1346: };
1347: my @Concepts;
1348: foreach my $concept (sort $sortfunction (keys(%Concepts))) {
1349: if (! defined($Concepts{$concept})) {
1350: $Concepts{$concept}=[];
1351: # next;
1352: }
1353: push(@Concepts,{ name => $concept,
1354: foils => [@{$Concepts{$concept}}]});
1355: push(@Foils,(@{$Concepts{$concept}}));
1356: }
1357: #
1358: # Build up the table of row labels.
1359: my $table = '<table border="1" >'."\n";
1360: if (@Concepts > 1) {
1361: $table .= '<tr>'.
1362: '<th>'.&mt('Concept Number').'</th>'.
1363: '<th>'.&mt('Concept').'</th>'.
1364: '<th>'.&mt('Foil Number').'</th>'.
1365: '<th>'.&mt('Foil Name').'</th>'.
1366: '<th>'.&mt('Foil Text').'</th>'.
1367: '<th>'.&mt('Correct Value').'</th>'.
1368: "</tr>\n";
1369: } else {
1370: $table .= '<tr>'.
1371: '<th>'.&mt('Foil Number').'</th>'.
1372: '<th>'.&mt('Foil Name').'</th>'.
1373: '<th>'.&mt('Foil Text').'</th>'.
1374: '<th>'.&mt('Correct Value').'</th>'.
1375: "</tr>\n";
1376: }
1377: my $conceptindex = 1;
1378: my $foilindex = 1;
1379: foreach my $concept (@Concepts) {
1380: my @FoilsInConcept = @{$concept->{'foils'}};
1381: my $firstfoil = shift(@FoilsInConcept);
1382: if (@Concepts > 1) {
1383: $table .= '<tr>'.
1384: '<td>'.$conceptindex.'</td>'.
1385: '<td>'.&HTML::Entities::encode($concept->{'name'}).'</td>'.
1386: '<td>'.$foilindex++.'</td>'.
1387: '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'}).'</td>'.
1388: '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
1389: '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'}).'</td>'.
1390: "</tr>\n";
1391: } else {
1392: $table .= '<tr>'.
1393: '<td>'.$foilindex++.'</td>'.
1394: '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'}).'</td>'.
1395: '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
1396: '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'}).'</td>'.
1397: "</tr>\n";
1398: }
1399: foreach my $foilid (@FoilsInConcept) {
1400: if (@Concepts > 1) {
1401: $table .= '<tr>'.
1402: '<td></td>'.
1403: '<td></td>'.
1404: '<td>'.$foilindex.'</td>'.
1405: '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'}).'</td>'.
1406: '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
1407: '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'}).'</td>'.
1408: "</tr>\n";
1409: } else {
1410: $table .= '<tr>'.
1411: '<td>'.$foilindex.'</td>'.
1412: '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'}).'</td>'.
1413: '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
1414: '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'}).'</td>'.
1415: "</tr>\n";
1416: }
1417: } continue {
1418: $foilindex++;
1419: }
1420: } continue {
1421: $conceptindex++;
1422: }
1423: $table .= "</table>\n";
1424: #
1425: # Build option index with color stuff
1426: return ($table,\@Foils,\@Concepts);
1427: }
1428:
1429: sub build_option_index {
1430: my ($ORdata)= @_;
1431: my $table = "<table>\n";
1432: my $optionindex = 0;
1433: my @Rows;
1434: foreach my $option (&mt('correct option chosen'),@{$ORdata->{'_Options'}}) {
1435: push (@Rows,
1436: '<tr>'.
1437: '<td bgcolor="'.$plotcolors->[$optionindex++].'">'.
1438: (' 'x4).'</td>'.
1439: '<td>'.&HTML::Entities::encode($option).'</td>'.
1440: "</tr>\n");
1441: }
1442: shift(@Rows); # Throw away 'correct option chosen' color
1443: $table .= join('',reverse(@Rows));
1444: $table .= "</table>\n";
1445: }
1446:
1447: #########################################################
1448: #########################################################
1449: ##
1450: ## Generic Interface Routines
1451: ##
1452: #########################################################
1453: #########################################################
1454: sub CreateInterface {
1455: ##
1456: ## Environment variable initialization
1457: if (! exists$ENV{'form.AnalyzeOver'}) {
1458: $ENV{'form.AnalyzeOver'} = 'Tries';
1459: }
1460: ##
1461: ## Build the menu
1462: my $Str = '';
1463: $Str .= '<table cellspacing="5">'."\n";
1464: $Str .= '<tr>';
1465: $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
1466: $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
1467: # $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
1468: $Str .= '<td align="center"> </td>';
1469: $Str .= '</tr>'."\n";
1470: ##
1471: ##
1472: $Str .= '<tr><td align="center">'."\n";
1473: $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
1474: $Str .= '</td>';
1475: #
1476: $Str .= '<td align="center">';
1477: $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
1478: $Str .= '</td>';
1479: #
1480: # $Str .= '<td align="center">';
1481: my $only_seq_with_assessments = sub {
1482: my $s=shift;
1483: if ($s->{'num_assess'} < 1) {
1484: return 0;
1485: } else {
1486: return 1;
1487: }
1488: };
1489: &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
1490: $only_seq_with_assessments);
1491: ##
1492: ##
1493: $Str .= '<td>';
1494: { # These braces are here to organize the code, not scope it.
1495: {
1496: $Str .= '<nobr>'.&mt('Analyze Over ');
1497: $Str .= &Apache::loncommon::help_open_topic
1498: ('Analysis_Analyze_Over');
1499: $Str .='<select name="AnalyzeOver" >';
1500: $Str .= '<option value="Tries" ';
1501: if (! exists($ENV{'form.AnalyzeOver'}) ||
1502: $ENV{'form.AnalyzeOver'} eq 'Tries'){
1503: # Default to Tries
1504: $Str .= ' selected ';
1505: }
1506: $Str .= '>'.&mt('Tries').'</option>';
1507: $Str .= '<option value="Time" ';
1508: $Str .= ' selected ' if ($ENV{'form.AnalyzeOver'} eq 'Time');
1509: $Str .= '>'.&mt('Time').'</option>';
1510: $Str .= '</select>';
1511: $Str .= '</nobr><br />';
1512: }
1513: {
1514: $Str .= '<nobr>'.&mt('Analyze as ');
1515: $Str .= &Apache::loncommon::help_open_topic
1516: ('Analysis_Analyze_as');
1517: $Str .='<select name="AnalyzeAs" >';
1518: $Str .= '<option value="Concepts" ';
1519: if (! exists($ENV{'form.AnalyzeAs'}) ||
1520: $ENV{'form.AnalyzeAs'} eq 'Concepts'){
1521: # Default to Concepts
1522: $Str .= ' selected ';
1523: }
1524: $Str .= '>'.&mt('Concepts').'</option>';
1525: $Str .= '<option value="Foils" ';
1526: $Str .= ' selected ' if ($ENV{'form.AnalyzeAs'} eq 'Foils');
1527: $Str .= '>'.&mt('Foils').'</option>';
1528: $Str .= '</select></nobr><br />';
1529: }
1530: {
1531: $Str .= '<br /><nobr>'.&mt('Number of Plots:');
1532: $Str .= &Apache::loncommon::help_open_topic
1533: ('Analysis_num_plots');
1534: $Str .= '<select name="NumPlots">';
1535: if (! exists($ENV{'form.NumPlots'})
1536: || $ENV{'form.NumPlots'} < 1
1537: || $ENV{'form.NumPlots'} > 20) {
1538: $ENV{'form.NumPlots'} = 5;
1539: }
1540: foreach my $i (1,2,3,4,5,6,7,8,10,15,20) {
1541: $Str .= '<option value="'.$i.'" ';
1542: if ($ENV{'form.NumPlots'} == $i) { $Str.=' selected '; }
1543: $Str .= '>'.$i.'</option>';
1544: }
1545: $Str .= '</select></nobr>';
1546: }
1547: }
1548: $Str .= '</td>';
1549: ##
1550: ##
1551: $Str .= '</tr>'."\n";
1552: $Str .= '</table>'."\n";
1553: return $Str;
1554: }
1555:
1556: #########################################################
1557: #########################################################
1558: ##
1559: ## Misc Option Response functions
1560: ##
1561: #########################################################
1562: #########################################################
1563: sub get_time_from_row {
1564: my ($row) = @_;
1565: if (ref($row)) {
1566: return $row->[&Apache::loncoursedata::RD_timestamp()];
1567: }
1568: return undef;
1569: }
1570:
1571: sub get_tries_from_row {
1572: my ($row) = @_;
1573: if (ref($row)) {
1574: return $row->[&Apache::loncoursedata::RD_tries()];
1575: }
1576: return undef;
1577: }
1578:
1579: sub hashify_attempt {
1580: my ($row) = @_;
1581: my %attempt;
1582: $attempt{'tries'} = $row->[&Apache::loncoursedata::RD_tries()];
1583: $attempt{'submission'} = $row->[&Apache::loncoursedata::RD_submission()];
1584: $attempt{'award'} = $row->[&Apache::loncoursedata::RD_awarddetail()];
1585: $attempt{'timestamp'} = $row->[&Apache::loncoursedata::RD_timestamp()];
1586: return %attempt;
1587: }
1588:
1589: sub Process_OR_Row {
1590: my ($row) = @_;
1591: my %RowData;
1592: my $student_id = $row->[&Apache::loncoursedata::RD_student_id()];
1593: my $award = $row->[&Apache::loncoursedata::RD_awarddetail()];
1594: my $grading = $row->[&Apache::loncoursedata::RD_response_eval()];
1595: my $submission = $row->[&Apache::loncoursedata::RD_submission()];
1596: my $time = $row->[&Apache::loncoursedata::RD_timestamp()];
1597: my $tries = $row->[&Apache::loncoursedata::RD_tries()];
1598: return undef if ($award eq 'MISSING_ANSWER');
1599: if ($award =~ /(APPROX_ANS|EXACT_ANS)/) {
1600: $RowData{'_correct'} = 1;
1601: }
1602: $RowData{'_total'} = 1;
1603: my @Foilgrades = split('&',$grading);
1604: my @Foilsubs = split('&',$submission);
1605: for (my $j=0;$j<=$#Foilgrades;$j++) {
1606: my ($foilid,$correct) = split('=',$Foilgrades[$j]);
1607: $foilid = &Apache::lonnet::unescape($foilid);
1608: my (undef,$submission) = split('=',$Foilsubs[$j]);
1609: if ($correct) {
1610: $RowData{$foilid}->{'_correct'}++;
1611: } else {
1612: $submission = &Apache::lonnet::unescape($submission);
1613: $RowData{$foilid}->{$submission}++;
1614: }
1615: $RowData{$foilid}->{'_total'}++;
1616: }
1617: return %RowData;
1618: }
1619:
1620:
1621: sub analyze_problem_as_student {
1622: my ($resource,$sname,$sdom,$partid,$respid) = @_;
1623: my $url = $resource->{'src'};
1624: my $symb = $resource->{'symb'};
1625: my $courseid = $ENV{'request.course.id'};
1626: my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',
1627: 'grade_domain' => $sdom,
1628: 'grade_username' => $sname,
1629: 'grade_symb' => $symb,
1630: 'grade_courseid' => $courseid));
1631: (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
1632: my %Answer=&Apache::lonnet::str2hash($Answ);
1633: my $key = $partid.'.'.$respid.'.answer';
1634: my $student_answer = $Answer{$key}->[0];
1635: if (! defined($student_answer)) {
1636: $student_answer = $Answer{$key}->[1];
1637: }
1638: return ($student_answer);
1639: }
1640:
1641: ##
1642: ## get problem data and put it into a useful data structure.
1643: ## note: we must force each foil and option to not begin or end with
1644: ## spaces as they are stored without such data.
1645: ##
1646: sub get_problem_data {
1647: my ($url) = @_;
1648: my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
1649: (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
1650: my %Answer;
1651: %Answer=&Apache::lonnet::str2hash($Answ);
1652: my %Partdata;
1653: foreach my $part (@{$Answer{'parts'}}) {
1654: while (my($key,$value) = each(%Answer)) {
1655: #
1656: # Logging code:
1657: if (0) {
1658: &Apache::lonnet::logthis($part.' got key "'.$key.'"');
1659: if (ref($value) eq 'ARRAY') {
1660: &Apache::lonnet::logthis(' '.join(',',@$value));
1661: } else {
1662: &Apache::lonnet::logthis(' '.$value);
1663: }
1664: }
1665: # End of logging code
1666: next if ($key !~ /^$part/);
1667: $key =~ s/^$part\.//;
1668: if (ref($value) eq 'ARRAY') {
1669: if ($key eq 'options') {
1670: $Partdata{$part}->{'_Options'}=$value;
1671: } elsif ($key eq 'concepts') {
1672: $Partdata{$part}->{'_Concepts'}=$value;
1673: } elsif ($key =~ /^concept\.(.*)$/) {
1674: my $concept = $1;
1675: foreach my $foil (@$value) {
1676: $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
1677: $concept;
1678: }
1679: } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high)$/) {
1680: $Partdata{$part}->{$key}=$value;
1681: }
1682: } else {
1683: if ($key=~ /^foil\.text\.(.*)$/) {
1684: my $foil = $1;
1685: $Partdata{$part}->{'_Foils'}->{$foil}->{'name'}=$foil;
1686: $value =~ s/(\s*$|^\s*)//g;
1687: $Partdata{$part}->{'_Foils'}->{$foil}->{'text'}=$value;
1688: } elsif ($key =~ /^foil\.value\.(.*)$/) {
1689: my $foil = $1;
1690: $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;
1691: }
1692: }
1693: }
1694: }
1695: return %Partdata;
1696: }
1697:
1698: 1;
1699:
1700: __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