Annotation of loncom/interface/statistics/lonproblemstatistics.pm, revision 1.76
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: #
1.76 ! matthew 3: # $Id: lonproblemstatistics.pm,v 1.75 2004/03/29 18:22:28 matthew Exp $
1.1 stredwic 4: #
5: # Copyright Michigan State University Board of Trustees
6: #
7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
8: #
9: # LON-CAPA is free software; you can redistribute it and/or modify
10: # it under the terms of the GNU General Public License as published by
11: # the Free Software Foundation; either version 2 of the License, or
12: # (at your option) any later version.
13: #
14: # LON-CAPA is distributed in the hope that it will be useful,
15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17: # GNU General Public License for more details.
18: #
19: # You should have received a copy of the GNU General Public License
20: # along with LON-CAPA; if not, write to the Free Software
21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22: #
23: # /home/httpd/html/adm/gpl.txt
24: #
25: # http://www.lon-capa.org/
26: #
27: # (Navigate problems for statistical reports
28: #
1.47 matthew 29: ###############################################
30: ###############################################
31:
32: =pod
33:
34: =head1 NAME
35:
36: lonproblemstatistics
37:
38: =head1 SYNOPSIS
39:
40: Routines to present problem statistics to instructors via tables,
41: Excel files, and plots.
42:
43: =over 4
44:
45: =cut
46:
47: ###############################################
48: ###############################################
1.1 stredwic 49:
1.36 minaeibi 50: package Apache::lonproblemstatistics;
1.1 stredwic 51:
52: use strict;
53: use Apache::lonnet();
1.62 matthew 54: use Apache::loncommon();
1.1 stredwic 55: use Apache::lonhtmlcommon;
56: use Apache::loncoursedata;
1.41 matthew 57: use Apache::lonstatistics;
1.59 matthew 58: use Apache::lonlocal;
1.44 matthew 59: use Spreadsheet::WriteExcel;
1.70 matthew 60: use Apache::lonstathelpers();
1.71 matthew 61: use Time::HiRes;
1.73 matthew 62:
63: my @StatsArray;
64:
1.59 matthew 65: ##
66: ## Localization notes:
67: ##
68: ## in @Fields[0]->{'long_title'} is placed in Excel files and is used as the
69: ## header for plots created with Graph.pm, both of which more than likely do
70: ## not support localization.
71: ##
1.49 matthew 72: my @Fields = (
73: { name => 'problem_num',
74: title => 'P#',
75: align => 'right',
1.76 ! matthew 76: color => '#FFFFE6',
! 77: selectable => 'no',
! 78: selected => 'yes',
! 79: },
1.49 matthew 80: { name => 'container',
1.51 matthew 81: title => 'Sequence or Folder',
1.49 matthew 82: align => 'left',
83: color => '#FFFFE6',
1.76 ! matthew 84: sortable => 'yes',
! 85: selectable => 'no',
! 86: selected => 'yes',
! 87: },
1.49 matthew 88: { name => 'title',
89: title => 'Title',
90: align => 'left',
91: color => '#FFFFE6',
92: special => 'link',
1.76 ! matthew 93: sortable => 'yes',
! 94: selectable => 'no',
! 95: selected => 'yes',
! 96: },
1.49 matthew 97: { name => 'part',
98: title => 'Part',
99: align => 'left',
1.55 matthew 100: color => '#FFFFE6',
1.76 ! matthew 101: selectable => 'no',
! 102: selected => 'yes',
! 103: },
1.49 matthew 104: { name => 'num_students',
105: title => '#Stdnts',
106: align => 'right',
107: color => '#EEFFCC',
108: format => '%d',
109: sortable => 'yes',
110: graphable => 'yes',
1.76 ! matthew 111: long_title => 'Number of Students Attempting Problem',
! 112: selectable => 'yes',
! 113: selected => 'yes',
! 114: },
1.49 matthew 115: { name => 'tries',
116: title => 'Tries',
117: align => 'right',
118: color => '#EEFFCC',
119: format => '%d',
120: sortable => 'yes',
121: graphable => 'yes',
1.76 ! matthew 122: long_title => 'Total Number of Tries',
! 123: selectable => 'yes',
! 124: selected => 'yes',
! 125: },
1.49 matthew 126: { name => 'max_tries',
127: title => 'Max Tries',
128: align => 'right',
129: color => '#DDFFFF',
130: format => '%d',
131: sortable => 'yes',
132: graphable => 'yes',
1.76 ! matthew 133: long_title => 'Maximum Number of Tries',
! 134: selectable => 'yes',
! 135: selected => 'yes',
! 136: },
1.73 matthew 137: { name => 'min_tries',
138: title => 'Min Tries',
139: align => 'right',
140: color => '#DDFFFF',
141: format => '%d',
142: sortable => 'yes',
143: graphable => 'yes',
1.76 ! matthew 144: long_title => 'Minumum Number of Tries',
! 145: selectable => 'yes',
! 146: selected => 'yes',
! 147: },
1.49 matthew 148: { name => 'mean_tries',
149: title => 'Mean Tries',
150: align => 'right',
151: color => '#DDFFFF',
152: format => '%5.2f',
153: sortable => 'yes',
154: graphable => 'yes',
1.76 ! matthew 155: long_title => 'Average Number of Tries',
! 156: selectable => 'yes',
! 157: selected => 'yes',
! 158: },
1.49 matthew 159: { name => 'std_tries',
160: title => 'S.D. tries',
161: align => 'right',
162: color => '#DDFFFF',
163: format => '%5.2f',
164: sortable => 'yes',
165: graphable => 'yes',
1.76 ! matthew 166: long_title => 'Standard Deviation of Number of Tries',
! 167: selectable => 'yes',
! 168: selected => 'yes',
! 169: },
1.49 matthew 170: { name => 'skew_tries',
171: title => 'Skew Tries',
172: align => 'right',
173: color => '#DDFFFF',
174: format => '%5.2f',
175: sortable => 'yes',
176: graphable => 'yes',
1.76 ! matthew 177: long_title => 'Skew of Number of Tries',
! 178: selectable => 'yes',
! 179: selected => 'no',
! 180: },
1.49 matthew 181: { name => 'num_solved',
182: title => '#YES',
183: align => 'right',
184: color => '#FFDDDD',
1.63 matthew 185: format => '%4.1f',# format => '%d',
1.49 matthew 186: sortable => 'yes',
187: graphable => 'yes',
1.76 ! matthew 188: long_title => 'Number of Students able to Solve',
! 189: selectable => 'no',
! 190: selected => 'yes',
! 191: },
1.49 matthew 192: { name => 'num_override',
193: title => '#yes',
194: align => 'right',
195: color => '#FFDDDD',
1.63 matthew 196: format => '%4.1f',# format => '%d',
1.49 matthew 197: sortable => 'yes',
198: graphable => 'yes',
1.76 ! matthew 199: long_title => 'Number of Students given Override',
! 200: selectable => 'yes',
! 201: selected => 'yes',
! 202: },
1.73 matthew 203: { name => 'num_wrong',
204: title => '#Wrng',
1.49 matthew 205: align => 'right',
1.73 matthew 206: color => '#FFDDDD',
1.49 matthew 207: format => '%4.1f',
208: sortable => 'yes',
209: graphable => 'yes',
1.76 ! matthew 210: long_title => 'Percent of students whose final answer is wrong',
! 211: selectable => 'yes',
! 212: selected => 'yes',
! 213: },
1.73 matthew 214: { name => 'deg_of_diff',
215: title => 'DoDiff',
216: align => 'right',
217: color => '#FFFFE6',
218: format => '%5.2f',
219: sortable => 'yes',
220: graphable => 'yes',
221: long_title => 'Degree of Difficulty'.
1.76 ! matthew 222: '[ 1 - ((#YES+#yes) / Tries) ]',
! 223: selectable => 'yes',
! 224: selected => 'yes',
! 225: },
1.71 matthew 226: { name => 'deg_of_disc',
1.73 matthew 227: title => 'DoDisc',
1.71 matthew 228: align => 'right',
229: color => '#FFFFE6',
230: format => '%4.2f',
231: sortable => 'yes',
232: graphable => 'yes',
1.76 ! matthew 233: long_title => 'Degree of Discrimination',
! 234: selectable => 'yes',
! 235: selected => 'no',
! 236: },
1.49 matthew 237: );
238:
1.76 ! matthew 239: my %SelectedFields;
! 240:
! 241: sub parse_field_selection {
! 242: #
! 243: # Pull out the defaults
! 244: if (! defined($ENV{'form.fieldselections'})) {
! 245: $ENV{'form.fieldselections'} = [];
! 246: foreach my $field (@Fields) {
! 247: next if ($field->{'selectable'} ne 'yes');
! 248: if ($field->{'selected'} eq 'yes') {
! 249: push(@{$ENV{'form.fieldselections'}},$field->{'name'});
! 250: }
! 251: }
! 252: }
! 253: #
! 254: # This should not happen, but in case it does...
! 255: if (ref($ENV{'form.fieldselections'}) ne 'ARRAY') {
! 256: $ENV{'form.fieldselections'} = [$ENV{'form.fieldselections'}];
! 257: }
! 258: #
! 259: # Set the field data and the selected fields (for easier checking)
! 260: undef(%SelectedFields);
! 261: foreach my $field (@Fields) {
! 262: next if ($field->{'selectable'} ne 'yes');
! 263: $field->{'selected'} = 'no';
! 264: foreach my $selection (@{$ENV{'form.fieldselections'}}) {
! 265: if ($selection eq $field->{'name'} || $selection eq 'all') {
! 266: $field->{'selected'} = 'yes';
! 267: $SelectedFields{$field->{'name'}}++;
! 268: }
! 269: }
! 270: }
! 271: return;
! 272: }
! 273:
! 274: sub field_selection_input {
! 275: my $Str = '<select name="fieldselections" multiple size="5">'."\n";
! 276: $Str .= '<option value="all">all</option>'."\n";
! 277: foreach my $field (@Fields) {
! 278: next if ($field->{'selectable'} ne 'yes');
! 279: $Str .= ' <option value="'.$field->{'name'}.'" ';
! 280: if ($field->{'selected'} eq 'yes') {
! 281: $Str .= 'selected ';
! 282: }
! 283: $Str .= '>'.$field->{'title'}.'</option>'."\n";
! 284: }
! 285: $Str .= "</select>\n";
! 286: }
! 287:
1.47 matthew 288: ###############################################
289: ###############################################
290:
291: =pod
292:
293: =item &CreateInterface()
294:
295: Create the main intereface for the statistics page. Allows the user to
296: select sections, maps, and output.
297:
298: =cut
1.1 stredwic 299:
1.47 matthew 300: ###############################################
301: ###############################################
1.41 matthew 302: sub CreateInterface {
1.76 ! matthew 303: &parse_field_selection();
1.41 matthew 304: my $Str = '';
1.67 matthew 305: $Str .= &Apache::lonhtmlcommon::breadcrumbs
1.69 matthew 306: (undef,'Overall Problem Statistics','Statistics_Overall_Key');
1.41 matthew 307: $Str .= '<table cellspacing="5">'."\n";
308: $Str .= '<tr>';
1.59 matthew 309: $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
310: $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
311: $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
1.76 ! matthew 312: $Str .= '<td align="center"><b>'.&mt('Statistics').'</b></td>';
1.70 matthew 313: $Str .= '<td rowspan="2">'.
314: &Apache::lonstathelpers::limit_by_time_form().'</td>';
1.41 matthew 315: $Str .= '</tr>'."\n";
316: #
317: $Str .= '<tr><td align="center">'."\n";
318: $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
1.50 matthew 319: $Str .= '</td><td align="center">';
320: $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
1.41 matthew 321: $Str .= '</td><td align="center">';
322: #
323: my $only_seq_with_assessments = sub {
324: my $s=shift;
325: if ($s->{'num_assess'} < 1) {
326: return 0;
327: } else {
328: return 1;
329: }
330: };
331: $Str .= &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
332: $only_seq_with_assessments);
1.76 ! matthew 333: $Str .= '</td><td>'.&field_selection_input();
1.41 matthew 334: $Str .= '</td></tr>'."\n";
335: $Str .= '</table>'."\n";
1.59 matthew 336: $Str .= '<input type="submit" name="GenerateStatistics" value="'.
337: &mt('Generate Statistics').'" />';
1.54 matthew 338: $Str .= ' 'x5;
1.73 matthew 339: $Str .= 'Plot '.&plot_dropdown().(' 'x10);
1.59 matthew 340: $Str .= '<input type="submit" name="ClearCache" value="'.
341: &mt('Clear Caches').'" />';
1.54 matthew 342: $Str .= ' 'x5;
1.73 matthew 343: $Str .= '<input type="submit" name="UpdateCache" value="'.
344: &mt('Update Student Data').'" />';
345: $Str .= ' 'x5;
346: $Str .= '<input type="submit" name="Excel" value="'.
347: &mt('Produce Excel Output').'" />';
348: $Str .= ' 'x5;
349: return $Str;
1.41 matthew 350: }
1.25 stredwic 351:
1.41 matthew 352: ###############################################
353: ###############################################
1.28 stredwic 354:
1.47 matthew 355: =pod
356:
357: =item &BuildProblemStatisticsPage()
358:
359: Main interface to problem statistics.
360:
361: =cut
362:
1.41 matthew 363: ###############################################
364: ###############################################
365: sub BuildProblemStatisticsPage {
366: my ($r,$c)=@_;
1.61 matthew 367: #
368: my %Saveable_Parameters = ('Status' => 'scalar',
369: 'statsoutputmode' => 'scalar',
370: 'Section' => 'array',
371: 'StudentData' => 'array',
372: 'Maps' => 'array');
373: &Apache::loncommon::store_course_settings('statistics',
374: \%Saveable_Parameters);
375: &Apache::loncommon::restore_course_settings('statistics',
376: \%Saveable_Parameters);
377: #
378: &Apache::lonstatistics::PrepareClasslist();
1.41 matthew 379: #
1.73 matthew 380: # Clear the package variables
381: undef(@StatsArray);
1.71 matthew 382: #
1.73 matthew 383: # Finally let the user know we are here
384: my $interface = &CreateInterface();
1.57 matthew 385: $r->print($interface);
1.41 matthew 386: $r->print('<input type="hidden" name="sortby" value="'.$ENV{'form.sortby'}.
387: '" />');
1.73 matthew 388: #
1.41 matthew 389: if (! exists($ENV{'form.statsfirstcall'})) {
1.73 matthew 390: $r->print('<input type="hidden" name="statsfirstcall" value="yes" />');
391: $r->print('<h3>'.
392: &mt('Press "Generate Statistics" when you are ready.').
393: '</h3><p>'.
394: &mt('It may take some time to update the student data '.
395: 'for the first analysis. Future analysis this session '.
396: ' will not have this delay.').
397: '</p>');
1.41 matthew 398: return;
1.73 matthew 399: } elsif ($ENV{'form.statsfirstcall'} eq 'yes' ||
400: exists($ENV{'form.UpdateCache'}) ||
401: exists($ENV{'form.ClearCache'}) ) {
402: $r->print('<input type="hidden" name="statsfirstcall" value="no" />');
403: &Apache::lonstatistics::Gather_Student_Data($r);
404: } else {
405: $r->print('<input type="hidden" name="statsfirstcall" value="no" />');
1.28 stredwic 406: }
1.73 matthew 407: $r->rflush();
1.41 matthew 408: #
1.73 matthew 409: # This probably does not need to be done each time we are called, but
410: # it does not slow things down noticably.
411: &Apache::loncoursedata::populate_weight_table();
1.75 matthew 412: #
1.73 matthew 413: if (exists($ENV{'form.Excel'})) {
414: &Excel_output($r);
415: } else {
1.75 matthew 416: my $count = 0;
417: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
418: $count += $seq->{'num_assess'};
419: }
420: if ($count > 10) {
421: $r->print('<h2>'.
422: &mt('Compiling statistics for [_1] problems',$count).
423: '</h2>');
424: if ($count > 30) {
425: $r->print('<h3>'.&mt('This will take some time.').'</h3>');
426: }
427: $r->rflush();
428: }
429: #
1.73 matthew 430: my $sortby = $ENV{'form.sortby'};
431: $sortby = 'container' if (! defined($sortby) || $sortby =~ /^\s*$/);
432: my $plot = $ENV{'form.plot'};
1.75 matthew 433: if ($plot eq '' || $plot eq 'none') {
434: undef($plot);
435: }
1.73 matthew 436: if ($sortby eq 'container' && ! defined($plot)) {
437: &output_html_by_sequence($r);
438: } else {
439: if (defined($plot)) {
440: &make_plot($r,$plot);
441: }
442: &output_html_stats($r);
443: }
444: }
445: return;
446: }
447:
448: ##########################################################
449: ##########################################################
450: ##
451: ## HTML output routines
452: ##
453: ##########################################################
454: ##########################################################
455: sub output_html_by_sequence {
456: my ($r) = @_;
457: my $c = $r->connection();
458: $r->print(&html_preamble());
1.41 matthew 459: #
1.73 matthew 460: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
461: last if ($c->aborted);
462: next if ($seq->{'num_assess'} < 1);
463: $r->print("<h3>".$seq->{'title'}."</h3>".
464: '<table border="0"><tr><td bgcolor="#777777">'."\n".
465: '<table border="0" cellpadding="3">'."\n".
466: '<tr bgcolor="#FFFFE6">'.
467: &statistics_table_header('no container')."</tr>\n");
468: my @Data = &compute_statistics_on_sequence($seq);
469: foreach my $data (@Data) {
470: $r->print('<tr>'.&statistics_html_table_data($data,
471: 'no container').
472: "</tr>\n");
1.70 matthew 473: }
1.73 matthew 474: $r->print('</table>'."\n".'</table>'."\n");
1.41 matthew 475: $r->rflush();
1.28 stredwic 476: }
1.41 matthew 477: return;
478: }
1.21 stredwic 479:
1.73 matthew 480: sub output_html_stats {
481: my ($r)=@_;
482: &compute_all_statistics($r);
483: $r->print(&html_preamble());
484: &sort_data($ENV{'form.sortby'});
485: #
486: my $count=0;
487: foreach my $data (@StatsArray) {
488: if ($count++ % 50 == 0) {
489: $r->print("</table>\n</table>\n");
490: $r->print('<table border="0"><tr><td bgcolor="#777777">'."\n".
491: '<table border="0" cellpadding="3">'."\n".
492: '<tr bgcolor="#FFFFE6">'.
493: '<tr bgcolor="#FFFFE6">'.
494: &statistics_table_header().
495: "</tr>\n");
496: }
497: $r->print('<tr>'.&statistics_html_table_data($data)."</tr>\n");
498: }
499: $r->print("</table>\n</table>\n");
500: return;
501: }
1.47 matthew 502:
1.73 matthew 503: sub html_preamble {
504: my $Str='';
505: $Str .= "<h2>".
506: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
507: "</h2>\n";
508: my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits();
509: if (defined($starttime) || defined($endtime)) {
510: # Inform the user what the time limits on the data are.
511: $Str .= '<h3>'.&mt('Statistics on submissions from [_1] to [_2]',
512: &Apache::lonlocal::locallocaltime($starttime),
513: &Apache::lonlocal::locallocaltime($endtime)
514: ).'</h3>';
515: }
516: $Str .= "<h3>".&mt('Compiled on [_1]',
517: &Apache::lonlocal::locallocaltime(time))."</h3>";
518: return $Str;
519: }
1.47 matthew 520:
521:
1.44 matthew 522: ###############################################
523: ###############################################
1.73 matthew 524: ##
525: ## Misc HTML output routines
526: ##
527: ###############################################
528: ###############################################
529: sub statistics_html_table_data {
530: my ($data,$options) = @_;
531: my $row = '';
532: foreach my $field (@Fields) {
533: next if ($options =~ /no $field->{'name'}/);
1.76 ! matthew 534: next if ($field->{'selected'} ne 'yes');
1.73 matthew 535: $row .= '<td bgcolor="'.$field->{'color'}.'"';
536: if (exists($field->{'align'})) {
537: $row .= ' align="'.$field->{'align'}.'"';
1.41 matthew 538: }
1.73 matthew 539: $row .= '>';
540: if (exists($field->{'special'}) && $field->{'special'} eq 'link') {
541: $row .= '<a href="'.$data->{$field->{'name'}.'.link'}.'">';
1.41 matthew 542: }
1.73 matthew 543: if (exists($field->{'format'})) {
544: $row .= sprintf($field->{'format'},$data->{$field->{'name'}});
545: } else {
546: $row .= $data->{$field->{'name'}};
547: }
548: if (exists($field->{'special'}) && $field->{'special'} eq 'link') {
549: $row.= '</a>';
550: }
551: $row .= '</td>';
1.21 stredwic 552: }
1.73 matthew 553: return $row;
1.41 matthew 554: }
1.25 stredwic 555:
1.73 matthew 556: sub statistics_table_header {
557: my ($options) = @_;
558: my $header_row;
559: foreach my $field (@Fields) {
560: next if ($options =~ /no $field->{'name'}/);
1.76 ! matthew 561: next if ($field->{'selected'} ne 'yes');
1.73 matthew 562: $header_row .= '<th>';
563: if (exists($field->{'sortable'}) && $field->{'sortable'} eq 'yes') {
564: $header_row .= '<a href="javascript:'.
565: 'document.Statistics.sortby.value='."'".$field->{'name'}."'".
566: ';document.Statistics.submit();">';
567: }
568: $header_row .= &mt($field->{'title'});
569: if ($options =~ /sortable/) {
570: $header_row.= '</a>';
571: }
572: if ($options !~ /no plots/ &&
573: exists($field->{'graphable'}) &&
574: $field->{'graphable'} eq 'yes') {
575: $header_row.=' (';
576: $header_row .= '<a href="javascript:'.
577: "document.Statistics.plot.value='$field->{'name'}'".
578: ';document.Statistics.submit();">';
579: $header_row .= &mt('plot').'</a>)';
580: }
581: $header_row .= '</th>';
582: }
583: return $header_row;
584: }
1.26 stredwic 585:
1.73 matthew 586: ####################################################
587: ####################################################
588: ##
589: ## Plotting Routines
590: ##
591: ####################################################
592: ####################################################
593: sub make_plot {
594: my ($r,$plot) = @_;
595: &compute_all_statistics($r);
596: &sort_data($ENV{'form.sortby'});
597: if ($plot eq 'degrees') {
598: °rees_plot($r);
1.74 matthew 599: } elsif ($plot eq 'tries statistics') {
600: &tries_data_plot($r);
1.73 matthew 601: } else {
602: &make_single_stat_plot($r,$plot);
603: }
604: return;
605: }
1.47 matthew 606:
1.73 matthew 607: sub make_single_stat_plot {
608: my ($r,$datafield) = @_;
1.41 matthew 609: #
1.73 matthew 610: my $title; my $yaxis;
611: foreach my $field (@Fields) {
612: next if ($field->{'name'} ne $datafield);
613: $title = $field->{'long_title'};
614: $yaxis = $field->{'title'};
615: last;
616: }
617: if ($title eq '' || $yaxis eq '') {
618: # datafield is something we do not know enough about to plot
619: $r->print('<h3>'.
620: &mt('Unable to plot the requested statistic.').
621: '</h3>');
622: return;
1.49 matthew 623: }
624: #
1.73 matthew 625: # Build up the data sets to plot
626: my @Labels;
627: my @Data;
628: my $max = 1;
629: foreach my $data (@StatsArray) {
630: push(@Labels,$data->{'problem_num'});
631: push(@Data,$data->{$datafield});
632: if ($data->{$datafield}>$max) {
633: $max = $data->{$datafield};
634: }
635: }
636: foreach (1,2,3,4,5,10,15,20,25,40,50,75,100,150,200,250,300,500,600,750,
637: 1000,1500,2000,2500,3000,3500,4000,5000,7500,10000,15000,20000) {
638: if ($max <= $_) {
639: $max = $_;
640: last;
1.42 matthew 641: }
642: }
1.73 matthew 643: if ($max > 20000) {
644: $max = 10000*(int($max/10000)+1);
1.42 matthew 645: }
1.73 matthew 646: #
647: $r->print("<p>".&Apache::loncommon::DrawBarGraph($title,
648: 'Problem Number',
649: $yaxis,
650: $max,
651: undef, # colors
652: \@Labels,
653: \@Data)."</p>\n");
654: return;
655: }
656:
657: sub degrees_plot {
658: my ($r)=@_;
659: my $count = scalar(@StatsArray);
660: my $width = 50 + 10*$count;
661: $width = 300 if ($width < 300);
662: my $height = 300;
663: my $plot = '';
664: my $ymax = 0;
665: my $ymin = 0;
666: my @Disc; my @Diff; my @Labels;
667: foreach my $data (@StatsArray) {
668: push(@Labels,$data->{'problem_num'});
669: my $disc = $data->{'deg_of_disc'};
670: my $diff = $data->{'deg_of_diff'};
671: push(@Disc,$disc);
672: push(@Diff,$diff);
673: #
674: $ymin = $disc if ($ymin > $disc);
675: $ymin = $diff if ($ymin > $diff);
676: $ymax = $disc if ($ymax < $disc);
677: $ymax = $diff if ($ymax < $diff);
678: }
679: #
680: # Make sure we show relevant information.
681: if ($ymin < 0) {
682: if (abs($ymin) < 0.05) {
683: $ymin = 0;
684: } else {
685: $ymin = -1;
1.42 matthew 686: }
687: }
1.73 matthew 688: if ($ymax > 0) {
689: if (abs($ymax) < 0.05) {
690: $ymax = 0;
1.42 matthew 691: } else {
1.73 matthew 692: $ymax = 1;
1.42 matthew 693: }
1.43 matthew 694: }
1.49 matthew 695: #
1.73 matthew 696: my $xmax = $Labels[-1];
697: if ($xmax > 50) {
698: if ($xmax % 10 != 0) {
699: $xmax = 10 * (int($xmax/10)+1);
700: }
701: } else {
702: if ($xmax % 5 != 0) {
703: $xmax = 5 * (int($xmax/5)+1);
1.49 matthew 704: }
1.26 stredwic 705: }
1.41 matthew 706: #
1.73 matthew 707: my $discdata .= '<data>'.join(',',@Labels).'</data>'.$/.
708: '<data>'.join(',',@Disc).'</data>'.$/;
709: #
710: my $diffdata .= '<data>'.join(',',@Labels).'</data>'.$/.
711: '<data>'.join(',',@Diff).'</data>'.$/;
712: #
713: $plot=<<"END";
714: <gnuplot
715: texfont="10"
716: fgcolor="x000000"
717: plottype="Cartesian"
718: font="large"
719: grid="on"
720: align="center"
721: border="on"
722: transparent="on"
723: alttag="Sample Plot"
724: samples="100"
725: bgcolor="xffffff"
726: height="$height"
727: width="$width">
728: <key
729: pos="top right"
730: title=""
731: box="off" />
732: <title>Degree of Discrmination and Degree of Difficulty</title>
733: <axis xmin="0" ymin="$ymin" xmax="$xmax" ymax="$ymax" color="x000000" />
734: <xlabel>Problem Number</xlabel>
735: <curve
736: linestyle="linespoints"
737: name="DoDisc"
738: pointtype="0"
739: color="x000000">
740: $discdata
741: </curve>
742: <curve
743: linestyle="linespoints"
744: name="DoDiff"
745: pointtype="0"
746: color="xFF0000">
747: $diffdata
748: </curve>
749: </gnuplot>
750: END
751: my $plotresult =
752: '<p>'.&Apache::lonxml::xmlparse($r,'web',$plot).'</p>'.$/;
753: $r->print($plotresult);
1.41 matthew 754: return;
1.42 matthew 755: }
756:
1.74 matthew 757: sub tries_data_plot {
758: my ($r)=@_;
759: my $count = scalar(@StatsArray);
760: my $width = 50 + 10*$count;
761: $width = 300 if ($width < 300);
762: my $height = 300;
763: my $plot = '';
764: my @STD; my @Mean; my @Max; my @Min;
765: my @Labels;
766: my $ymax = 5;
767: foreach my $data (@StatsArray) {
768: my $max = $data->{'mean_tries'} + $data->{'std_tries'};
769: $ymax = $max if ($ymax < $max);
770: $ymax = $max if ($ymax < $max);
771: push(@Labels,$data->{'problem_num'});
772: push(@STD,$data->{'std_tries'});
773: push(@Mean,$data->{'mean_tries'});
774: }
775: #
776: # Make sure we show relevant information.
777: my $xmax = $Labels[-1];
778: if ($xmax > 50) {
779: if ($xmax % 10 != 0) {
780: $xmax = 10 * (int($xmax/10)+1);
781: }
782: } else {
783: if ($xmax % 5 != 0) {
784: $xmax = 5 * (int($xmax/5)+1);
785: }
786: }
787: $ymax = int($ymax)+1+2;
788: #
789: my $std_data .= '<data>'.join(',',@Labels).'</data>'.$/.
790: '<data>'.join(',',@Mean).'</data>'.$/;
791: #
792: my $std_error_data .= '<data>'.join(',',@Labels).'</data>'.$/.
793: '<data>'.join(',',@Mean).'</data>'.$/.
794: '<data>'.join(',',@STD).'</data>'.$/;
795: #
796: $plot=<<"END";
797: <gnuplot
798: texfont="10"
799: fgcolor="x000000"
800: plottype="Cartesian"
801: font="large"
802: grid="on"
803: align="center"
804: border="on"
805: transparent="on"
806: alttag="Sample Plot"
807: samples="100"
808: bgcolor="xffffff"
809: height="$height"
810: width="$width">
811: <title>Mean and S.D. of Tries</title>
812: <axis xmin="0" ymin="0" xmax="$xmax" ymax="$ymax" color="x000000" />
813: <xlabel>Problem Number</xlabel>
814: <curve
815: linestyle="yerrorbars"
816: name="S.D. Tries"
817: pointtype="1"
818: color="x666666">
819: $std_error_data
820: </curve>
821: <curve
822: linestyle="points"
823: name="Mean Tries"
824: pointtype="1"
825: color="xCC4444">
826: $std_data
827: </curve>
828: </gnuplot>
829: END
830: my $plotresult =
831: '<p>'.&Apache::lonxml::xmlparse($r,'web',$plot).'</p>'.$/;
832: $r->print($plotresult);
833: return;
834: }
835:
1.73 matthew 836: sub plot_dropdown {
837: my $current = '';
838: #
839: if (defined($ENV{'form.plot'})) {
840: $current = $ENV{'form.plot'};
841: }
842: #
843: my @Additional_Plots = (
844: { graphable=>'yes',
845: name => 'degrees',
1.74 matthew 846: title => 'DoDisc and DoDiff' },
847: { graphable=>'yes',
848: name => 'tries statistics',
849: title => 'Mean and S.D. of Tries' });
1.73 matthew 850: #
851: my $Str= "\n".'<select name="plot" size="1">';
852: $Str .= '<option name="none"></option>'."\n";
853: $Str .= '<option name="none2">none</option>'."\n";
854: foreach my $field (@Fields,@Additional_Plots) {
855: if (! exists($field->{'graphable'}) ||
856: $field->{'graphable'} ne 'yes') {
857: next;
858: }
859: $Str .= '<option value="'.$field->{'name'}.'"';
860: if ($field->{'name'} eq $current) {
861: $Str .= ' selected ';
862: }
863: $Str.= '>'.&mt($field->{'title'}).'</option>'."\n";
864: }
865: $Str .= '</select>'."\n";
866: return $Str;
867: }
868:
1.41 matthew 869: ###############################################
870: ###############################################
1.73 matthew 871: ##
872: ## Excel output routines
873: ##
1.41 matthew 874: ###############################################
875: ###############################################
1.73 matthew 876: sub Excel_output {
1.44 matthew 877: my ($r) = @_;
1.73 matthew 878: $r->print('<h2>'.&mt('Preparing Excel Spreadsheet').'</h2>');
879: ##
880: ## Compute the statistics
881: &compute_all_statistics($r);
882: my $c = $r->connection;
883: return if ($c->aborted());
884: ##
885: ## Create the excel workbook
1.44 matthew 886: my $filename = '/prtspool/'.
887: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
1.73 matthew 888: time.'_'.rand(1000000000).'.xls';
1.70 matthew 889: my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits();
890: #
1.44 matthew 891: # Create sheet
1.73 matthew 892: my $excel_workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1.44 matthew 893: #
894: # Check for errors
895: if (! defined($excel_workbook)) {
896: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.59 matthew 897: $r->print(&mt("Problems creating new Excel file. ".
1.44 matthew 898: "This error has been logged. ".
1.59 matthew 899: "Please alert your LON-CAPA administrator."));
1.73 matthew 900: return 0;
1.44 matthew 901: }
902: #
903: # The excel spreadsheet stores temporary data in files, then put them
904: # together. If needed we should be able to disable this (memory only).
905: # The temporary directory must be specified before calling 'addworksheet'.
906: # File::Temp is used to determine the temporary directory.
907: $excel_workbook->set_tempdir($Apache::lonnet::tmpdir);
908: #
909: # Add a worksheet
910: my $sheetname = $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
911: if (length($sheetname) > 31) {
912: $sheetname = substr($sheetname,0,31);
913: }
1.73 matthew 914: my $excel_sheet = $excel_workbook->addworksheet(
915: &Apache::loncommon::clean_excel_name($sheetname));
916: ##
917: ## Begin creating excel sheet
918: ##
919: my ($rows_output,$cols_output) = (0,0);
1.44 matthew 920: #
921: # Put the course description in the header
922: $excel_sheet->write($rows_output,$cols_output++,
923: $ENV{'course.'.$ENV{'request.course.id'}.'.description'});
924: $cols_output += 3;
925: #
926: # Put a description of the sections listed
927: my $sectionstring = '';
928: my @Sections = @Apache::lonstatistics::SelectedSections;
929: if (scalar(@Sections) > 1) {
930: if (scalar(@Sections) > 2) {
931: my $last = pop(@Sections);
932: $sectionstring = "Sections ".join(', ',@Sections).', and '.$last;
933: } else {
934: $sectionstring = "Sections ".join(' and ',@Sections);
935: }
936: } else {
937: if ($Sections[0] eq 'all') {
938: $sectionstring = "All sections";
939: } else {
940: $sectionstring = "Section ".$Sections[0];
941: }
942: }
943: $excel_sheet->write($rows_output,$cols_output++,$sectionstring);
944: $cols_output += scalar(@Sections);
945: #
1.70 matthew 946: # Time restrictions
947: my $time_string;
948: if (defined($starttime)) {
949: # call localtime but not lonlocal:locallocaltime because excel probably
950: # cannot handle localized text. Probably.
951: $time_string .= 'Data collected from '.localtime($time_string);
952: if (defined($endtime)) {
953: $time_string .= ' to '.localtime($endtime);
954: }
955: $time_string .= '.';
956: } elsif (defined($endtime)) {
957: # See note above about lonlocal:locallocaltime
958: $time_string .= 'Data collected before '.localtime($endtime).'.';
959: }
960: #
1.44 matthew 961: # Put the date in there too
962: $excel_sheet->write($rows_output,$cols_output++,
963: 'Compiled on '.localtime(time));
964: #
965: $rows_output++;
966: $cols_output=0;
967: #
1.73 matthew 968: # Long Headers
1.55 matthew 969: foreach my $field (@Fields) {
970: next if ($field->{'name'} eq 'problem_num');
1.76 ! matthew 971: next if ($field->{'selected'} ne 'yes');
1.55 matthew 972: if (exists($field->{'long_title'})) {
973: $excel_sheet->write($rows_output,$cols_output++,
974: $field->{'long_title'});
975: } else {
976: $excel_sheet->write($rows_output,$cols_output++,'');
977: }
978: }
979: $rows_output++;
980: $cols_output=0;
981: # Brief headers
1.49 matthew 982: foreach my $field (@Fields) {
1.76 ! matthew 983: next if ($field->{'selected'} ne 'yes');
1.49 matthew 984: next if ($field->{'name'} eq 'problem_num');
1.59 matthew 985: # Use english for excel as I am not sure how well excel handles
986: # other character sets....
1.49 matthew 987: $excel_sheet->write($rows_output,$cols_output++,$field->{'title'});
1.44 matthew 988: }
989: $rows_output++;
1.73 matthew 990: foreach my $data (@StatsArray) {
991: $cols_output=0;
992: foreach my $field (@Fields) {
1.76 ! matthew 993: next if ($field->{'selected'} ne 'yes');
1.73 matthew 994: next if ($field->{'name'} eq 'problem_num');
995: $excel_sheet->write($rows_output,$cols_output++,
996: $data->{$field->{'name'}});
1.44 matthew 997: }
1.73 matthew 998: $rows_output++;
1.44 matthew 999: }
1000: #
1001: $excel_workbook->close();
1.73 matthew 1002: #
1.44 matthew 1003: # Tell the user where to get their excel file
1004: $r->print('<br />'.
1.59 matthew 1005: '<a href="'.$filename.'">'.
1006: &mt('Your Excel Spreadsheet').'</a>'."\n");
1.44 matthew 1007: $r->rflush();
1008: return;
1009: }
1010:
1.73 matthew 1011: ##################################################
1012: ##################################################
1013: ##
1014: ## Statistics Gathering and Manipulation Routines
1015: ##
1016: ##################################################
1017: ##################################################
1018: sub compute_statistics_on_sequence {
1019: my ($seq) = @_;
1020: my @Data;
1021: foreach my $res (@{$seq->{'contents'}}) {
1022: next if ($res->{'type'} ne 'assessment');
1023: foreach my $part (@{$res->{'parts'}}) {
1024: #
1025: # This is where all the work happens
1026: my $data = &get_statistics($seq,$res,$part,scalar(@StatsArray)+1);
1027: push (@Data,$data);
1028: push (@StatsArray,$data);
1.49 matthew 1029: }
1.26 stredwic 1030: }
1.73 matthew 1031: return @Data;
1.41 matthew 1032: }
1.26 stredwic 1033:
1.73 matthew 1034: sub compute_all_statistics {
1035: my ($r) = @_;
1036: if (@StatsArray > 0) {
1037: # Assume we have already computed the statistics
1038: return;
1039: }
1040: my $c = $r->connection;
1041: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
1042: last if ($c->aborted);
1043: next if ($seq->{'num_assess'} < 1);
1044: &compute_statistics_on_sequence($seq);
1.49 matthew 1045: }
1046: }
1047:
1.73 matthew 1048: sub sort_data {
1049: my ($sortkey) = @_;
1050: return if (! @StatsArray);
1.45 matthew 1051: #
1.73 matthew 1052: # Sort the data
1053: my $sortby = undef;
1.49 matthew 1054: foreach my $field (@Fields) {
1.73 matthew 1055: if ($sortkey eq $field->{'name'}) {
1056: $sortby = $field->{'name'};
1.45 matthew 1057: }
1.26 stredwic 1058: }
1.73 matthew 1059: if (! defined($sortby) || $sortby eq '' || $sortby eq 'problem_num') {
1060: $sortby = 'container';
1061: }
1062: if ($sortby ne 'container') {
1063: # $sortby is already defined, so we can charge ahead
1064: if ($sortby =~ /^(title|part)$/i) {
1065: # Alpha comparison
1066: @StatsArray = sort {
1067: lc($a->{$sortby}) cmp lc($b->{$sortby}) ||
1068: lc($a->{'title'}) cmp lc($b->{'title'}) ||
1069: lc($a->{'part'}) cmp lc($b->{'part'});
1070: } @StatsArray;
1.24 stredwic 1071: } else {
1.73 matthew 1072: # Numerical comparison
1073: @StatsArray = sort {
1074: my $retvalue = 0;
1075: if ($b->{$sortby} eq 'nan') {
1076: if ($a->{$sortby} ne 'nan') {
1077: $retvalue = -1;
1078: } else {
1079: $retvalue = 0;
1080: }
1081: }
1082: if ($a->{$sortby} eq 'nan') {
1083: if ($b->{$sortby} ne 'nan') {
1084: $retvalue = 1;
1085: }
1086: }
1087: if ($retvalue eq '0') {
1088: $retvalue = $b->{$sortby} <=> $a->{$sortby} ||
1089: lc($a->{'title'}) <=> lc($b->{'title'}) ||
1090: lc($a->{'part'}) <=> lc($b->{'part'});
1091: }
1092: $retvalue;
1093: } @StatsArray;
1.24 stredwic 1094: }
1095: }
1.45 matthew 1096: #
1.73 matthew 1097: # Renumber the data set
1098: my $count;
1099: foreach my $data (@StatsArray) {
1100: $data->{'problem_num'} = ++$count;
1101: }
1.24 stredwic 1102: return;
1.48 matthew 1103: }
1104:
1.70 matthew 1105: ########################################################
1106: ########################################################
1107:
1108: =pod
1109:
1110: =item &get_statistics()
1111:
1112: Wrapper routine from the call to loncoursedata::get_problem_statistics.
1.73 matthew 1113: Calls lonstathelpers::get_time_limits() to limit the data set by time
1114: and &compute_discrimination_factor
1.70 matthew 1115:
1116: Inputs: $sequence, $resource, $part, $problem_num
1117:
1118: Returns: Hash reference with statistics data from
1119: loncoursedata::get_problem_statistics.
1120:
1121: =cut
1122:
1123: ########################################################
1124: ########################################################
1.48 matthew 1125: sub get_statistics {
1.49 matthew 1126: my ($sequence,$resource,$part,$problem_num) = @_;
1.48 matthew 1127: #
1.70 matthew 1128: my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits();
1.49 matthew 1129: my $symb = $resource->{'symb'};
1.48 matthew 1130: my $courseid = $ENV{'request.course.id'};
1131: #
1.49 matthew 1132: my $data = &Apache::loncoursedata::get_problem_statistics
1.66 matthew 1133: (\@Apache::lonstatistics::SelectedSections,
1134: $Apache::lonstatistics::enrollment_status,
1.70 matthew 1135: $symb,$part,$courseid,$starttime,$endtime);
1.49 matthew 1136: $data->{'part'} = $part;
1137: $data->{'problem_num'} = $problem_num;
1138: $data->{'container'} = $sequence->{'title'};
1139: $data->{'title'} = $resource->{'title'};
1.53 matthew 1140: $data->{'title.link'} = $resource->{'src'}.'?symb='.
1141: &Apache::lonnet::escape($resource->{'symb'});
1.49 matthew 1142: #
1.76 ! matthew 1143: if ($SelectedFields{'deg_of_disc'}) {
! 1144: $data->{'deg_of_disc'} =
! 1145: &compute_discrimination_factor($resource,$part,$sequence);
! 1146: }
1.49 matthew 1147: return $data;
1.71 matthew 1148: }
1149:
1150:
1151: ###############################################
1152: ###############################################
1153:
1154: =pod
1155:
1156: =item &compute_discrimination_factor()
1157:
1158: Inputs: $Resource, $Sequence
1159:
1160: Returns: integer between -1 and 1
1161:
1162: =cut
1163:
1164: ###############################################
1165: ###############################################
1166: sub compute_discrimination_factor {
1167: my ($resource,$part,$sequence) = @_;
1168: my @Resources;
1169: foreach my $res (@{$sequence->{'contents'}}) {
1170: next if ($res->{'symb'} eq $resource->{'symb'});
1171: push (@Resources,$res->{'symb'});
1172: }
1173: #
1174: # rank
1175: my $ranking =
1176: &Apache::loncoursedata::rank_students_by_scores_on_resources
1177: (\@Resources,
1178: \@Apache::lonstatistics::SelectedSections,
1179: $Apache::lonstatistics::enrollment_status,undef);
1180: #
1181: # compute their percent scores on the problems in the sequence,
1182: my $number_to_grab = int(scalar(@{$ranking})/4);
1183: my $num_students = scalar(@{$ranking});
1184: my @BottomSet = map { $_->[&Apache::loncoursedata::RNK_student()];
1185: } @{$ranking}[0..$number_to_grab];
1186: my @TopSet =
1187: map {
1188: $_->[&Apache::loncoursedata::RNK_student()];
1189: } @{$ranking}[($num_students-$number_to_grab)..($num_students-1)];
1190: my ($bottom_sum,$bottom_max) =
1191: &Apache::loncoursedata::get_sum_of_scores($resource,$part,\@BottomSet);
1192: my ($top_sum,$top_max) =
1193: &Apache::loncoursedata::get_sum_of_scores($resource,$part,\@TopSet);
1194: my $deg_of_disc;
1195: if ($top_max == 0 || $bottom_max==0) {
1196: $deg_of_disc = 'nan';
1197: } else {
1198: $deg_of_disc = ($top_sum/$top_max) - ($bottom_sum/$bottom_max);
1199: }
1200: #&Apache::lonnet::logthis(' '.$top_sum.'/'.$top_max.
1201: # ' - '.$bottom_sum.'/'.$bottom_max);
1202: return $deg_of_disc;
1.1 stredwic 1203: }
1.12 minaeibi 1204:
1.45 matthew 1205: ###############################################
1206: ###############################################
1.47 matthew 1207:
1208: =pod
1209:
1.73 matthew 1210: =item ProblemStatisticsLegend
1211:
1212: =over 4
1213:
1214: =item #Stdnts
1215: Total number of students attempted the problem.
1216:
1217: =item Tries
1218: Total number of tries for solving the problem.
1.59 matthew 1219:
1.73 matthew 1220: =item Max Tries
1221: Largest number of tries for solving the problem by a student.
1222:
1223: =item Mean
1224: Average number of tries. [ Tries / #Stdnts ]
1225:
1226: =item #YES
1227: Number of students solved the problem correctly.
1228:
1229: =item #yes
1230: Number of students solved the problem by override.
1231:
1232: =item %Wrong
1233: Percentage of students who tried to solve the problem
1234: but is still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]
1235:
1236: =item DoDiff
1237: Degree of Difficulty of the problem.
1238: [ 1 - ((#YES+#yes) / Tries) ]
1239:
1240: =item S.D.
1241: Standard Deviation of the tries.
1242: [ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1)
1243: where Xi denotes every student\'s tries ]
1244:
1245: =item Skew.
1246: Skewness of the students tries.
1247: [(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]
1248:
1249: =item Dis.F.
1250: Discrimination Factor: A Standard for evaluating the
1251: problem according to a Criterion<br>
1252:
1253: =item [Criterion to group students into %27 Upper Students -
1254: and %27 Lower Students]
1255: 1st Criterion for Sorting the Students:
1256: Sum of Partial Credit Awarded / Total Number of Tries
1257: 2nd Criterion for Sorting the Students:
1258: Total number of Correct Answers / Total Number of Tries
1259:
1260: =item Disc.
1261: Number of Students had at least one discussion.
1262:
1263: =back
1.47 matthew 1264:
1265: =cut
1.1 stredwic 1266:
1.73 matthew 1267:
1268: ############################################################
1269: ############################################################
1270: ##
1271: ## How this all works:
1272: ## Statistics are computed by calling &get_statistics with the sequence,
1273: ## resource, and part id to run statistics on. At various places within
1274: ## the loops which compute the statistics, as well as before and after
1275: ## the entire process, subroutines can be called. The subroutines are
1276: ## registered to the following hooks:
1277: ##
1278: ## hook subroutine inputs
1279: ## ----------------------------------------------------------
1280: ## pre $r,$count
1281: ## pre_seq $r,$count,$seq
1282: ## pre_res $r,$count,$seq,$res
1283: ## calc $r,$count,$seq,$res,$data
1284: ## post_res $r,$count,$seq,$res
1285: ## post_seq $r,$count,$seq
1286: ## post $r,$count
1287: ##
1288: ## abort $r
1289: ##
1290: ## subroutines will be called in the order in which they are registered.
1291: ##
1292: ############################################################
1293: ############################################################
1294: {
1295:
1296: my %hooks;
1297: my $aborted = 0;
1298:
1299: sub abort_computation {
1300: $aborted = 1;
1301: }
1302:
1303: sub clear_hooks {
1304: $aborted = 0;
1305: undef(%hooks);
1306: }
1307:
1308: sub register_hook {
1309: my ($hookname,$subref)=@_;
1310: if ($hookname !~ /^(pre|pre_seq|pre_res|post|post_seq|post_res|calc)$/){
1311: return;
1312: }
1313: if (ref($subref) ne 'CODE') {
1314: &Apache::lonnet::logthis('attempt to register hook to non-code: '.
1315: $hookname,' = '.$subref);
1316: } else {
1317: if (exists($hooks{$hookname})) {
1318: push(@{$hooks{$hookname}},$subref);
1319: } else {
1320: $hooks{$hookname} = [$subref];
1321: }
1322: }
1323: return;
1324: }
1325:
1326: sub run_hooks {
1327: my $context = shift();
1328: foreach my $hook (@{$hooks{$context}}) {
1329: if ($aborted && $context ne 'abort') {
1330: last;
1331: }
1332: my $retvalue = $hook->(@_);
1333: if (defined($retvalue) && $retvalue eq '0') {
1334: $aborted = 1 if (! $aborted);
1335: }
1336: }
1337: }
1338:
1339: sub run_statistics {
1340: my ($r) = @_;
1341: my $count = 0;
1342: &run_hooks('pre',$r,$count);
1343: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
1344: last if ($aborted);
1345: next if ($seq->{'num_assess'}<1);
1346: &run_hooks('pre_seq',$r,$count,$seq);
1347: foreach my $res (@{$seq->{'contents'}}) {
1348: last if ($aborted);
1349: next if ($res->{'type'} ne 'assessment');
1350: &run_hooks('pre_res',$r,$count,$seq,$res);
1351: foreach my $part (@{$res->{'parts'}}) {
1352: last if ($aborted);
1353: #
1354: # This is where all the work happens
1355: my $data = &get_statistics($seq,$res,$part,++$count);
1356: &run_hooks('calc',$r,$count,$seq,$res,$part,$data);
1357: }
1358: &run_hooks('post_res',$r,$count,$seq,$res);
1359: }
1360: &run_hooks('post_seq',$r,$count,$seq);
1361: }
1362: if ($aborted) {
1363: &run_hooks('abort',$r);
1364: } else {
1365: &run_hooks('post',$r,$count);
1366: }
1367: return;
1.1 stredwic 1368: }
1.24 stredwic 1369:
1.73 matthew 1370: } # End of %hooks scope
1371:
1372: ############################################################
1373: ############################################################
1.4 minaeibi 1374:
1.1 stredwic 1375: 1;
1376: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonproblemstatistics.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface / statistics