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