[LON-CAPA-cvs] cvs: loncom /interface/statistics lonproblemstatistics.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Fri, 26 Mar 2004 22:04:22 -0000
This is a MIME encoded message
--matthew1080338662
Content-Type: text/plain
matthew Fri Mar 26 17:04:22 2004 EDT
Modified files:
/loncom/interface/statistics lonproblemstatistics.pm
Log:
Complete rewrite/reworking of code and signifigant rewrite of interface.
Added combined DoDiff and DoDisc plot.
--matthew1080338662
Content-Type: text/plain
Content-Disposition: attachment; filename="matthew-20040326170422.txt"
Index: loncom/interface/statistics/lonproblemstatistics.pm
diff -u loncom/interface/statistics/lonproblemstatistics.pm:1.72 loncom/interface/statistics/lonproblemstatistics.pm:1.73
--- loncom/interface/statistics/lonproblemstatistics.pm:1.72 Tue Mar 23 15:08:58 2004
+++ loncom/interface/statistics/lonproblemstatistics.pm Fri Mar 26 17:04:22 2004
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonproblemstatistics.pm,v 1.72 2004/03/23 20:08:58 matthew Exp $
+# $Id: lonproblemstatistics.pm,v 1.73 2004/03/26 22:04:22 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,6 +59,9 @@
use Spreadsheet::WriteExcel;
use Apache::lonstathelpers();
use Time::HiRes;
+
+my @StatsArray;
+
##
## Localization notes:
##
@@ -111,6 +114,14 @@
sortable => 'yes',
graphable => 'yes',
long_title => 'Maximum Number of Tries' },
+ { name => 'min_tries',
+ title => 'Min Tries',
+ align => 'right',
+ color => '#DDFFFF',
+ format => '%d',
+ sortable => 'yes',
+ graphable => 'yes',
+ long_title => 'Minumum Number of Tries' },
{ name => 'mean_tries',
title => 'Mean Tries',
align => 'right',
@@ -135,15 +146,6 @@
sortable => 'yes',
graphable => 'yes',
long_title => 'Skew of Number of Tries' },
- { name => 'deg_of_diff',
- title => 'DoDiff',
- align => 'right',
- color => '#DDFFFF',
- format => '%5.2f',
- sortable => 'yes',
- graphable => 'yes',
- long_title => 'Degree of Difficulty'.
- '[ 1 - ((#YES+#yes) / Tries) ]'},
{ name => 'num_solved',
title => '#YES',
align => 'right',
@@ -160,23 +162,31 @@
sortable => 'yes',
graphable => 'yes',
long_title => 'Number of Students given Override' },
- { name => 'per_wrong',
- title => '%Wrng',
+ { name => 'num_wrong',
+ title => '#Wrng',
align => 'right',
- color => '#FFFFE6',
+ color => '#FFDDDD',
format => '%4.1f',
sortable => 'yes',
graphable => 'yes',
long_title => 'Percent of students whose final answer is wrong' },
+ { name => 'deg_of_diff',
+ title => 'DoDiff',
+ align => 'right',
+ color => '#FFFFE6',
+ format => '%5.2f',
+ sortable => 'yes',
+ graphable => 'yes',
+ long_title => 'Degree of Difficulty'.
+ '[ 1 - ((#YES+#yes) / Tries) ]'},
{ name => 'deg_of_disc',
- title => 'Deg of Disc',
+ title => 'DoDisc',
align => 'right',
color => '#FFFFE6',
format => '%4.2f',
sortable => 'yes',
graphable => 'yes',
long_title => 'Degree of Discrimination' },
-
);
###############################################
@@ -193,29 +203,6 @@
###############################################
###############################################
-my @OutputOptions =
- (
- { name => 'grouped by sequence',
- value => 'HTML problem statistics grouped',
- description => 'Output statistics for the problem parts.',
- mode => 'html',
- show => 'grouped',
- },
- { name => 'ungrouped',
- value => 'HTML problem statistics ungrouped',
- description => 'Output statistics for the problem parts.',
- mode => 'html',
- show => 'ungrouped',
- },
- { name => 'Excel',
- value => 'Excel problem statistics',
- description => 'Output statistics for the problem parts '.
- 'in an Excel workbook',
- mode => 'excel',
- show => 'all',
- },
- );
-
sub CreateInterface {
my $Str = '';
$Str .= &Apache::lonhtmlcommon::breadcrumbs
@@ -225,7 +212,6 @@
$Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
$Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
$Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
- $Str .= '<td align="center"><b>'.&mt('Output').'</b></td>';
$Str .= '<td rowspan="2">'.
&Apache::lonstathelpers::limit_by_time_form().'</td>';
$Str .= '</tr>'."\n";
@@ -246,22 +232,22 @@
};
$Str .= &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
$only_seq_with_assessments);
- $Str .= '</td><td>'."\n";
- my ($html,$outputmode,$show) =
- &Apache::lonstatistics::CreateAndParseOutputSelector(
- 'statsoutputmode',
- 'HTML problem statistics grouped',
- @OutputOptions);
- $Str .= $html;
$Str .= '</td></tr>'."\n";
$Str .= '</table>'."\n";
$Str .= '<input type="submit" name="GenerateStatistics" value="'.
&mt('Generate Statistics').'" />';
$Str .= ' 'x5;
+ $Str .= 'Plot '.&plot_dropdown().(' 'x10);
$Str .= '<input type="submit" name="ClearCache" value="'.
&mt('Clear Caches').'" />';
$Str .= ' 'x5;
- return ($Str,$outputmode,$show);
+ $Str .= '<input type="submit" name="UpdateCache" value="'.
+ &mt('Update Student Data').'" />';
+ $Str .= ' 'x5;
+ $Str .= '<input type="submit" name="Excel" value="'.
+ &mt('Produce Excel Output').'" />';
+ $Str .= ' 'x5;
+ return $Str;
}
###############################################
@@ -292,250 +278,418 @@
#
&Apache::lonstatistics::PrepareClasslist();
#
- &Apache::loncoursedata::populate_weight_table();
+ # Clear the package variables
+ undef(@StatsArray);
#
- my ($interface,$output_mode,$show) = &CreateInterface();
+ # Finally let the user know we are here
+ my $interface = &CreateInterface();
$r->print($interface);
- $r->print('<input type="hidden" name="statsfirstcall" value="no" />');
$r->print('<input type="hidden" name="sortby" value="'.$ENV{'form.sortby'}.
'" />');
- $r->print('<input type="hidden" name="plot" value="" />');
+ #
if (! exists($ENV{'form.statsfirstcall'})) {
+ $r->print('<input type="hidden" name="statsfirstcall" value="yes" />');
+ $r->print('<h3>'.
+ &mt('Press "Generate Statistics" when you are ready.').
+ '</h3><p>'.
+ &mt('It may take some time to update the student data '.
+ 'for the first analysis. Future analysis this session '.
+ ' will not have this delay.').
+ '</p>');
return;
+ } elsif ($ENV{'form.statsfirstcall'} eq 'yes' ||
+ exists($ENV{'form.UpdateCache'}) ||
+ exists($ENV{'form.ClearCache'}) ) {
+ $r->print('<input type="hidden" name="statsfirstcall" value="no" />');
+ &Apache::lonstatistics::Gather_Student_Data($r);
+ } else {
+ $r->print('<input type="hidden" name="statsfirstcall" value="no" />');
}
+ $r->rflush();
#
- &Apache::lonstatistics::Gather_Student_Data($r);
- #
+ # This probably does not need to be done each time we are called, but
+ # it does not slow things down noticably.
+ &Apache::loncoursedata::populate_weight_table();
+ if (exists($ENV{'form.Excel'})) {
+ &Excel_output($r);
+ } else {
+ my $sortby = $ENV{'form.sortby'};
+ $sortby = 'container' if (! defined($sortby) || $sortby =~ /^\s*$/);
+ my $plot = $ENV{'form.plot'};
+ &Apache::lonnet::logthis('form.plot = '.$plot);
+ if ($sortby eq 'container' && ! defined($plot)) {
+ &output_html_by_sequence($r);
+ } else {
+ if (defined($plot)) {
+ &Apache::lonnet::logthis('calling plot routine');
+ &make_plot($r,$plot);
+ }
+ &output_html_stats($r);
+ }
+ }
+ return;
+}
+
+##########################################################
+##########################################################
+##
+## HTML output routines
+##
+##########################################################
+##########################################################
+sub output_html_by_sequence {
+ my ($r) = @_;
+ my $c = $r->connection();
+ $r->print(&html_preamble());
#
- if ($output_mode eq 'html') {
- $r->print("<h2>".
- $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
- "</h2>\n");
- my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits();
- if (defined($starttime) || defined($endtime)) {
- # Inform the user what the time limits on the data are.
- $r->print('<h3>'.&mt('Statistics on submissions from [_1] to [_2]',
- &Apache::lonlocal::locallocaltime($starttime),
- &Apache::lonlocal::locallocaltime($endtime)).
- '</h3>');
+ foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+ last if ($c->aborted);
+ next if ($seq->{'num_assess'} < 1);
+ $r->print("<h3>".$seq->{'title'}."</h3>".
+ '<table border="0"><tr><td bgcolor="#777777">'."\n".
+ '<table border="0" cellpadding="3">'."\n".
+ '<tr bgcolor="#FFFFE6">'.
+ &statistics_table_header('no container')."</tr>\n");
+ my @Data = &compute_statistics_on_sequence($seq);
+ foreach my $data (@Data) {
+ $r->print('<tr>'.&statistics_html_table_data($data,
+ 'no container').
+ "</tr>\n");
}
- $r->print("<h3>".&mt('Compiled on [_1]',
- &Apache::lonlocal::locallocaltime(time))."</h3>");
+ $r->print('</table>'."\n".'</table>'."\n");
$r->rflush();
- if ($show eq 'grouped') {
- &output_html_grouped_by_sequence($r);
- } elsif ($show eq 'ungrouped') {
- &output_html_ungrouped($r);
- }
- } elsif ($output_mode eq 'excel') {
- $r->print('<h2>'.&mt('Preparing Excel Spreadsheet').'</h2>');
- &output_excel($r);
- } else {
- $r->print('<h1>'.&mt('Not implemented').'</h1>');
}
return;
}
-###############################################
-###############################################
+sub output_html_stats {
+ my ($r)=@_;
+ &compute_all_statistics($r);
+ $r->print(&html_preamble());
+ &sort_data($ENV{'form.sortby'});
+ #
+ my $count=0;
+ foreach my $data (@StatsArray) {
+ if ($count++ % 50 == 0) {
+ $r->print("</table>\n</table>\n");
+ $r->print('<table border="0"><tr><td bgcolor="#777777">'."\n".
+ '<table border="0" cellpadding="3">'."\n".
+ '<tr bgcolor="#FFFFE6">'.
+ '<tr bgcolor="#FFFFE6">'.
+ &statistics_table_header().
+ "</tr>\n");
+ }
+ $r->print('<tr>'.&statistics_html_table_data($data)."</tr>\n");
+ }
+ $r->print("</table>\n</table>\n");
+ return;
+}
-=pod
-=item &output_html_grouped_by_sequence()
+sub html_preamble {
+ my $Str='';
+ $Str .= "<h2>".
+ $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
+ "</h2>\n";
+ my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits();
+ if (defined($starttime) || defined($endtime)) {
+ # Inform the user what the time limits on the data are.
+ $Str .= '<h3>'.&mt('Statistics on submissions from [_1] to [_2]',
+ &Apache::lonlocal::locallocaltime($starttime),
+ &Apache::lonlocal::locallocaltime($endtime)
+ ).'</h3>';
+ }
+ $Str .= "<h3>".&mt('Compiled on [_1]',
+ &Apache::lonlocal::locallocaltime(time))."</h3>";
+ return $Str;
+}
-Presents the statistics data as an html table organized by the order
-the assessments appear in the course.
-
-=cut
###############################################
###############################################
-sub output_html_grouped_by_sequence {
- my ($r) = @_;
- my $problem_num = 0;
- #$r->print(&ProblemStatisticsLegend());
- foreach my $sequence (&Apache::lonstatistics::Sequences_with_Assess()) {
- next if ($sequence->{'num_assess'}<1);
- $r->print("<h3>".$sequence->{'title'}."</h3>");
- $r->print('<table border="0"><tr><td bgcolor="#777777">'."\n");
- $r->print('<table border="0" cellpadding="3">'."\n");
- $r->print('<tr bgcolor="#FFFFE6">');
- my $Str = &statistics_table_header('no container no plots');
- $r->print('<tr bgcolor="#FFFFE6">'.$Str."</tr>\n");
- foreach my $resource (@{$sequence->{'contents'}}) {
- next if ($resource->{'type'} ne 'assessment');
- foreach my $part (@{$resource->{'parts'}}) {
- $problem_num++;
- my $data = &get_statistics($sequence,$resource,$part,
- $problem_num);
- my $option = '';
- $r->print('<tr>'.&statistics_html_table_data($data,
- 'no container').
- "</tr>\n");
+##
+## Misc HTML output routines
+##
+###############################################
+###############################################
+sub statistics_html_table_data {
+ my ($data,$options) = @_;
+ my $row = '';
+ foreach my $field (@Fields) {
+ next if ($options =~ /no $field->{'name'}/);
+ $row .= '<td bgcolor="'.$field->{'color'}.'"';
+ if (exists($field->{'align'})) {
+ $row .= ' align="'.$field->{'align'}.'"';
}
+ $row .= '>';
+ if (exists($field->{'special'}) && $field->{'special'} eq 'link') {
+ $row .= '<a href="'.$data->{$field->{'name'}.'.link'}.'">';
}
- $r->print("</table>\n");
- $r->print("</td></tr></table>\n");
- $r->rflush();
+ if (exists($field->{'format'})) {
+ $row .= sprintf($field->{'format'},$data->{$field->{'name'}});
+ } else {
+ $row .= $data->{$field->{'name'}};
+ }
+ if (exists($field->{'special'}) && $field->{'special'} eq 'link') {
+ $row.= '</a>';
+ }
+ $row .= '</td>';
}
- #
- return;
+ return $row;
}
-###############################################
-###############################################
-
-=pod
-
-=item &output_html_ungrouped()
-
-Presents the statistics data in a single html table which can be sorted by
-different columns.
+sub statistics_table_header {
+ my ($options) = @_;
+ my $header_row;
+ foreach my $field (@Fields) {
+ next if ($options =~ /no $field->{'name'}/);
+ $header_row .= '<th>';
+ if (exists($field->{'sortable'}) && $field->{'sortable'} eq 'yes') {
+ $header_row .= '<a href="javascript:'.
+ 'document.Statistics.sortby.value='."'".$field->{'name'}."'".
+ ';document.Statistics.submit();">';
+ }
+ $header_row .= &mt($field->{'title'});
+ if ($options =~ /sortable/) {
+ $header_row.= '</a>';
+ }
+ if ($options !~ /no plots/ &&
+ exists($field->{'graphable'}) &&
+ $field->{'graphable'} eq 'yes') {
+ $header_row.=' (';
+ $header_row .= '<a href="javascript:'.
+ "document.Statistics.plot.value='$field->{'name'}'".
+ ';document.Statistics.submit();">';
+ $header_row .= &mt('plot').'</a>)';
+ }
+ $header_row .= '</th>';
+ }
+ return $header_row;
+}
-=cut
+####################################################
+####################################################
+##
+## Plotting Routines
+##
+####################################################
+####################################################
+sub make_plot {
+ my ($r,$plot) = @_;
+ &compute_all_statistics($r);
+ &sort_data($ENV{'form.sortby'});
+ if ($plot eq 'degrees') {
+ °rees_plot($r);
+ } else {
+ &make_single_stat_plot($r,$plot);
+ }
+ return;
+}
-###############################################
-###############################################
-sub output_html_ungrouped {
- my ($r,$option) = @_;
+sub make_single_stat_plot {
+ my ($r,$datafield) = @_;
#
- if (exists($ENV{'form.plot'}) && $ENV{'form.plot'} ne '') {
- &plot_statistics($r,$ENV{'form.plot'});
+ my $title; my $yaxis;
+ foreach my $field (@Fields) {
+ next if ($field->{'name'} ne $datafield);
+ $title = $field->{'long_title'};
+ $yaxis = $field->{'title'};
+ last;
+ }
+ if ($title eq '' || $yaxis eq '') {
+ # datafield is something we do not know enough about to plot
+ $r->print('<h3>'.
+ &mt('Unable to plot the requested statistic.').
+ '</h3>');
+ return;
}
#
- my $problem_num = 0;
- my $show_container = 0;
- my $show_part = 0;
- #$r->print(&ProblemStatisticsLegend());
- my $sortby = undef;
- foreach my $field (@Fields) {
- if ($ENV{'form.sortby'} eq $field->{'name'}) {
- $sortby = $field->{'name'};
+ # Build up the data sets to plot
+ my @Labels;
+ my @Data;
+ my $max = 1;
+ foreach my $data (@StatsArray) {
+ push(@Labels,$data->{'problem_num'});
+ push(@Data,$data->{$datafield});
+ if ($data->{$datafield}>$max) {
+ $max = $data->{$datafield};
+ }
+ }
+ foreach (1,2,3,4,5,10,15,20,25,40,50,75,100,150,200,250,300,500,600,750,
+ 1000,1500,2000,2500,3000,3500,4000,5000,7500,10000,15000,20000) {
+ if ($max <= $_) {
+ $max = $_;
+ last;
}
}
- if (! defined($sortby) || $sortby eq '' || $sortby eq 'problem_num') {
- $sortby = 'container';
+ if ($max > 20000) {
+ $max = 10000*(int($max/10000)+1);
}
- # If there is more than one sequence, list their titles
- my @Sequences = &Apache::lonstatistics::Sequences_with_Assess();
- if (@Sequences < 1) {
- $option .= ' no container';
- }
- #
- # Compile the data
- my @Statsarray;
- foreach my $sequence (@Sequences) {
- next if ($sequence->{'num_assess'}<1);
- foreach my $resource (@{$sequence->{'contents'}}) {
- next if ($resource->{'type'} ne 'assessment');
- foreach my $part (@{$resource->{'parts'}}) {
- $problem_num++;
- my $data = &get_statistics($sequence,$resource,$part,
- $problem_num);
- $show_part = 1 if ($part ne '0');
- #
- push (@Statsarray,$data);
- }
+ #
+ $r->print("<p>".&Apache::loncommon::DrawBarGraph($title,
+ 'Problem Number',
+ $yaxis,
+ $max,
+ undef, # colors
+ \@Labels,
+ \@Data)."</p>\n");
+ return;
+}
+
+sub degrees_plot {
+ my ($r)=@_;
+ my $count = scalar(@StatsArray);
+ my $width = 50 + 10*$count;
+ $width = 300 if ($width < 300);
+ my $height = 300;
+ my $plot = '';
+ my $ymax = 0;
+ my $ymin = 0;
+ my @Disc; my @Diff; my @Labels;
+ foreach my $data (@StatsArray) {
+ push(@Labels,$data->{'problem_num'});
+ my $disc = $data->{'deg_of_disc'};
+ my $diff = $data->{'deg_of_diff'};
+ push(@Disc,$disc);
+ push(@Diff,$diff);
+ #
+ $ymin = $disc if ($ymin > $disc);
+ $ymin = $diff if ($ymin > $diff);
+ $ymax = $disc if ($ymax < $disc);
+ $ymax = $diff if ($ymax < $diff);
+ }
+ #
+ # Make sure we show relevant information.
+ if ($ymin < 0) {
+ if (abs($ymin) < 0.05) {
+ $ymin = 0;
+ } else {
+ $ymin = -1;
}
}
- #
- # Sort the data
- my @OutputOrder;
- if ($sortby eq 'container') {
- @OutputOrder = @Statsarray;
- } else {
- # $sortby is already defined, so we can charge ahead
- if ($sortby =~ /^(title|part)$/i) {
- # Alpha comparison
- @OutputOrder = sort {
- lc($a->{$sortby}) cmp lc($b->{$sortby}) ||
- lc($a->{'title'}) cmp lc($b->{'title'}) ||
- lc($a->{'part'}) cmp lc($b->{'part'});
- } @Statsarray;
+ if ($ymax > 0) {
+ if (abs($ymax) < 0.05) {
+ $ymax = 0;
} else {
- # Numerical comparison
- @OutputOrder = sort {
- my $retvalue = 0;
- if ($b->{$sortby} eq 'nan') {
- if ($a->{$sortby} ne 'nan') {
- $retvalue = -1;
- } else {
- $retvalue = 0;
- }
- }
- if ($a->{$sortby} eq 'nan') {
- if ($b->{$sortby} ne 'nan') {
- $retvalue = 1;
- }
- }
- if ($retvalue eq '0') {
- $retvalue = $b->{$sortby} <=> $a->{$sortby} ||
- lc($a->{'title'}) <=> lc($b->{'title'}) ||
- lc($a->{'part'}) <=> lc($b->{'part'});
- }
- $retvalue;
- } @Statsarray;
+ $ymax = 1;
}
}
- $option .= 'no part' if (! $show_part);
- my $num_output = 0;
#
- # output the headers
- $r->print('<table border="0"><tr><td bgcolor="#777777">'."\n");
- $r->print('<table border="0" cellpadding="3">'."\n");
- my $Str = &statistics_table_header($option.' sortable');
- $r->print('<tr bgcolor="#FFFFE6">'.$Str."</tr>\n");
- #
- foreach my $rowdata (@OutputOrder) {
- $num_output++;
- if ($num_output % 25 == 0) {
- $r->print("</table>\n</td></tr></table>\n");
- #
- $r->print('<table border="0"><tr><td bgcolor="#777777">'."\n");
- $r->print('<table border="0" cellpadding="3">'."\n");
- my $Str = &statistics_table_header($option.' sortable');
- $r->print('<tr bgcolor="#FFFFE6">'.$Str."</tr>\n");
- $r->rflush();
+ my $xmax = $Labels[-1];
+ if ($xmax > 50) {
+ if ($xmax % 10 != 0) {
+ $xmax = 10 * (int($xmax/10)+1);
+ }
+ } else {
+ if ($xmax % 5 != 0) {
+ $xmax = 5 * (int($xmax/5)+1);
}
- $r->print('<tr>'.&statistics_html_table_data($rowdata,$option).
- "</tr>\n");
}
- $r->print("</table>\n");
- $r->print("</td></tr></table>\n");
- $r->rflush();
#
+ my $discdata .= '<data>'.join(',',@Labels).'</data>'.$/.
+ '<data>'.join(',',@Disc).'</data>'.$/;
+ #
+ my $diffdata .= '<data>'.join(',',@Labels).'</data>'.$/.
+ '<data>'.join(',',@Diff).'</data>'.$/;
+ #
+ $plot=<<"END";
+<gnuplot
+ texfont="10"
+ fgcolor="x000000"
+ plottype="Cartesian"
+ font="large"
+ grid="on"
+ align="center"
+ border="on"
+ transparent="on"
+ alttag="Sample Plot"
+ samples="100"
+ bgcolor="xffffff"
+ height="$height"
+ width="$width">
+ <key
+ pos="top right"
+ title=""
+ box="off" />
+ <title>Degree of Discrmination and Degree of Difficulty</title>
+ <axis xmin="0" ymin="$ymin" xmax="$xmax" ymax="$ymax" color="x000000" />
+ <xlabel>Problem Number</xlabel>
+ <curve
+ linestyle="linespoints"
+ name="DoDisc"
+ pointtype="0"
+ color="x000000">
+ $discdata
+ </curve>
+ <curve
+ linestyle="linespoints"
+ name="DoDiff"
+ pointtype="0"
+ color="xFF0000">
+ $diffdata
+ </curve>
+</gnuplot>
+END
+ my $plotresult =
+ '<p>'.&Apache::lonxml::xmlparse($r,'web',$plot).'</p>'.$/;
+ $r->print($plotresult);
return;
}
+sub plot_dropdown {
+ my $current = '';
+ #
+ if (defined($ENV{'form.plot'})) {
+ $current = $ENV{'form.plot'};
+ }
+ #
+ my @Additional_Plots = (
+ { graphable=>'yes',
+ name => 'degrees',
+ title => 'DoDisc and DoDiff' });
+ #
+ my $Str= "\n".'<select name="plot" size="1">';
+ $Str .= '<option name="none"></option>'."\n";
+ $Str .= '<option name="none2">none</option>'."\n";
+ foreach my $field (@Fields,@Additional_Plots) {
+ if (! exists($field->{'graphable'}) ||
+ $field->{'graphable'} ne 'yes') {
+ next;
+ }
+ $Str .= '<option value="'.$field->{'name'}.'"';
+ if ($field->{'name'} eq $current) {
+ $Str .= ' selected ';
+ }
+ $Str.= '>'.&mt($field->{'title'}).'</option>'."\n";
+ }
+ $Str .= '</select>'."\n";
+ return $Str;
+}
+
###############################################
###############################################
-
-=pod
-
-=item &output_excel()
-
-Presents the statistical data in an Excel 95 compatable spreadsheet file.
-
-=cut
-
+##
+## Excel output routines
+##
###############################################
###############################################
-sub output_excel {
+sub Excel_output {
my ($r) = @_;
+ $r->print('<h2>'.&mt('Preparing Excel Spreadsheet').'</h2>');
+ ##
+ ## Compute the statistics
+ &compute_all_statistics($r);
+ my $c = $r->connection;
+ return if ($c->aborted());
+ ##
+ ## Create the excel workbook
my $filename = '/prtspool/'.
$ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
- time.'_'.rand(1000000000).'.xls';
- #
+ time.'_'.rand(1000000000).'.xls';
my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits();
#
- my $excel_workbook = undef;
- my $excel_sheet = undef;
- #
- my $rows_output = 0;
- my $cols_output = 0;
- #
# Create sheet
- $excel_workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
+ my $excel_workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
#
# Check for errors
if (! defined($excel_workbook)) {
@@ -543,7 +697,7 @@
$r->print(&mt("Problems creating new Excel file. ".
"This error has been logged. ".
"Please alert your LON-CAPA administrator."));
- return ;
+ return 0;
}
#
# The excel spreadsheet stores temporary data in files, then put them
@@ -557,9 +711,12 @@
if (length($sheetname) > 31) {
$sheetname = substr($sheetname,0,31);
}
- $excel_sheet = $excel_workbook->addworksheet(
- &Apache::loncommon::clean_excel_name($sheetname)
- );
+ my $excel_sheet = $excel_workbook->addworksheet(
+ &Apache::loncommon::clean_excel_name($sheetname));
+ ##
+ ## Begin creating excel sheet
+ ##
+ my ($rows_output,$cols_output) = (0,0);
#
# Put the course description in the header
$excel_sheet->write($rows_output,$cols_output++,
@@ -600,7 +757,6 @@
# See note above about lonlocal:locallocaltime
$time_string .= 'Data collected before '.localtime($endtime).'.';
}
-
#
# Put the date in there too
$excel_sheet->write($rows_output,$cols_output++,
@@ -609,7 +765,7 @@
$rows_output++;
$cols_output=0;
#
- # Long Headersheaders
+ # Long Headers
foreach my $field (@Fields) {
next if ($field->{'name'} eq 'problem_num');
if (exists($field->{'long_title'})) {
@@ -629,34 +785,18 @@
$excel_sheet->write($rows_output,$cols_output++,$field->{'title'});
}
$rows_output++;
- #
- # Write the data
- my $problem_num=0;
- foreach my $sequence (&Apache::lonstatistics::Sequences_with_Assess()) {
- next if ($sequence->{'num_assess'}<1);
- foreach my $resource (@{$sequence->{'contents'}}) {
- next if ($resource->{'type'} ne 'assessment');
- foreach my $part (@{$resource->{'parts'}}) {
- $cols_output=0;
- $problem_num++;
- my $data = &get_statistics($sequence,$resource,$part,
- $problem_num);
- #
- if (!defined($part) || $part eq '') {
- $part = ' ';
- }
- foreach my $field (@Fields) {
- next if ($field->{'name'} eq 'problem_num');
- $excel_sheet->write($rows_output,$cols_output++,
- $data->{$field->{'name'}});
- }
- $rows_output++;
- }
+ foreach my $data (@StatsArray) {
+ $cols_output=0;
+ foreach my $field (@Fields) {
+ next if ($field->{'name'} eq 'problem_num');
+ $excel_sheet->write($rows_output,$cols_output++,
+ $data->{$field->{'name'}});
}
+ $rows_output++;
}
#
- # Write the excel file
$excel_workbook->close();
+ #
# Tell the user where to get their excel file
$r->print('<br />'.
'<a href="'.$filename.'">'.
@@ -665,161 +805,97 @@
return;
}
-###############################################
-###############################################
-
-=pod
-
-=item &statistics_html_table_data()
-
-Help function used to format the rows for HTML table output.
-
-=cut
-
-###############################################
-###############################################
-sub statistics_html_table_data {
- my ($data,$options) = @_;
- my $row = '';
- foreach my $field (@Fields) {
- next if ($options =~ /no $field->{'name'}/);
- $row .= '<td bgcolor="'.$field->{'color'}.'"';
- if (exists($field->{'align'})) {
- $row .= ' align="'.$field->{'align'}.'"';
- }
- $row .= '>';
- if (exists($field->{'special'}) && $field->{'special'} eq 'link') {
- $row .= '<a href="'.$data->{$field->{'name'}.'.link'}.'">';
- }
- if (exists($field->{'format'})) {
- $row .= sprintf($field->{'format'},$data->{$field->{'name'}});
- } else {
- $row .= $data->{$field->{'name'}};
- }
- if (exists($field->{'special'}) && $field->{'special'} eq 'link') {
- $row.= '</a>';
+##################################################
+##################################################
+##
+## Statistics Gathering and Manipulation Routines
+##
+##################################################
+##################################################
+sub compute_statistics_on_sequence {
+ my ($seq) = @_;
+ my @Data;
+ foreach my $res (@{$seq->{'contents'}}) {
+ next if ($res->{'type'} ne 'assessment');
+ foreach my $part (@{$res->{'parts'}}) {
+ #
+ # This is where all the work happens
+ my $data = &get_statistics($seq,$res,$part,scalar(@StatsArray)+1);
+ push (@Data,$data);
+ push (@StatsArray,$data);
}
- $row .= '</td>';
}
- return $row;
+ return @Data;
}
-sub statistics_table_header {
- my ($options) = @_;
- my $header_row;
- foreach my $field (@Fields) {
- next if ($options =~ /no $field->{'name'}/);
- $header_row .= '<th>';
- if ($options =~ /sortable/ &&
- exists($field->{'sortable'}) && $field->{'sortable'} eq 'yes') {
- $header_row .= '<a href="javascript:'.
- 'document.Statistics.sortby.value='."'".$field->{'name'}."'".
- ';document.Statistics.submit();">';
- }
- $header_row .= &mt($field->{'title'});
- if ($options =~ /sortable/) {
- $header_row.= '</a>';
- }
- if ($options !~ /no plots/ &&
- exists($field->{'graphable'}) &&
- $field->{'graphable'} eq 'yes') {
- $header_row.=' (';
- $header_row .= '<a href="javascript:'.
- "document.Statistics.plot.value='$field->{'name'}'".
- ';document.Statistics.submit();">';
- $header_row .= &mt('plot').'</a>)';
- }
- $header_row .= '</th>';
+sub compute_all_statistics {
+ my ($r) = @_;
+ if (@StatsArray > 0) {
+ # Assume we have already computed the statistics
+ return;
+ }
+ my $c = $r->connection;
+ foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+ last if ($c->aborted);
+ next if ($seq->{'num_assess'} < 1);
+ &compute_statistics_on_sequence($seq);
}
- return $header_row;
}
-###############################################
-###############################################
-
-=pod
-
-=item &plot_statistics()
-
-=cut
-
-###############################################
-###############################################
-sub plot_statistics {
- my ($r,$datafield) = @_;
- my @Data;
+sub sort_data {
+ my ($sortkey) = @_;
+ return if (! @StatsArray);
#
- #
- my $sortfield = undef;
- my $title = undef;
+ # Sort the data
+ my $sortby = undef;
foreach my $field (@Fields) {
- if ($datafield eq $field->{'name'} &&
- exists($field->{'graphable'}) && $field->{'graphable'} eq 'yes') {
- $sortfield = $field->{'name'};
- $title = $field->{'long_title'};
- }
- }
- return if (! defined($sortfield) || $sortfield eq '');
- #
- my $Max = 0;
- my $problem_num = 0;
- foreach my $sequence (&Apache::lonstatistics::Sequences_with_Assess()) {
- next if ($sequence->{'num_assess'}<1);
- foreach my $resource (@{$sequence->{'contents'}}) {
- next if ($resource->{'type'} ne 'assessment');
- foreach my $part (@{$resource->{'parts'}}) {
- my $problem_number++;
- my $data = &get_statistics($sequence,$resource,$part,
- $problem_num);
- my $value = $data->{$sortfield};
- $Max = $value if ($Max < $value);
- push (@Data,$value);
- }
+ if ($sortkey eq $field->{'name'}) {
+ $sortby = $field->{'name'};
}
}
- #
- # Print out plot request
- my $yaxis = '';
- if ($sortfield eq 'per_wrong') {
- $yaxis = 'Percent';
- }
- #
- # Determine appropriate value for $Max
- if ($sortfield eq 'deg_of_diff') {
- if ($Max > 0.5) {
- $Max = 1;
- } elsif ($Max > 0.2) {
- $Max = 0.5;
- } elsif ($Max > 0.1) {
- $Max = 0.2;
- }
- } elsif ($sortfield eq 'per_wrong') {
- if ($Max > 50) {
- $Max = 100;
- } elsif ($Max > 25) {
- $Max = 50;
- } elsif ($Max > 20) {
- $Max = 25;
- } elsif ($Max > 10) {
- $Max = 20;
- } elsif ($Max > 5) {
- $Max = 10;
+ if (! defined($sortby) || $sortby eq '' || $sortby eq 'problem_num') {
+ $sortby = 'container';
+ }
+ if ($sortby ne 'container') {
+ # $sortby is already defined, so we can charge ahead
+ if ($sortby =~ /^(title|part)$/i) {
+ # Alpha comparison
+ @StatsArray = sort {
+ lc($a->{$sortby}) cmp lc($b->{$sortby}) ||
+ lc($a->{'title'}) cmp lc($b->{'title'}) ||
+ lc($a->{'part'}) cmp lc($b->{'part'});
+ } @StatsArray;
} else {
- $Max = 5;
+ # Numerical comparison
+ @StatsArray = sort {
+ my $retvalue = 0;
+ if ($b->{$sortby} eq 'nan') {
+ if ($a->{$sortby} ne 'nan') {
+ $retvalue = -1;
+ } else {
+ $retvalue = 0;
+ }
+ }
+ if ($a->{$sortby} eq 'nan') {
+ if ($b->{$sortby} ne 'nan') {
+ $retvalue = 1;
+ }
+ }
+ if ($retvalue eq '0') {
+ $retvalue = $b->{$sortby} <=> $a->{$sortby} ||
+ lc($a->{'title'}) <=> lc($b->{'title'}) ||
+ lc($a->{'part'}) <=> lc($b->{'part'});
+ }
+ $retvalue;
+ } @StatsArray;
}
}
-
- $r->print("<p>".&Apache::loncommon::DrawBarGraph($title,
- 'Problem Number',
- $yaxis,
- $Max,
- undef, # colors
- undef, # labels
- \@Data)."</p>\n");
#
- # Print out the data
- $ENV{'form.sortby'} = 'Contents';
-# &output_html_ungrouped($r);
+ # Renumber the data set
+ my $count;
+ foreach my $data (@StatsArray) {
+ $data->{'problem_num'} = ++$count;
+ }
return;
}
@@ -831,7 +907,8 @@
=item &get_statistics()
Wrapper routine from the call to loncoursedata::get_problem_statistics.
-Calls lonstathelpers::get_time_limits() to limit the data set by time.
+Calls lonstathelpers::get_time_limits() to limit the data set by time
+and &compute_discrimination_factor
Inputs: $sequence, $resource, $part, $problem_num
@@ -924,70 +1001,170 @@
=pod
-=item &ProblemStatisticsLegend()
+=item ProblemStatisticsLegend
+
+=over 4
+
+=item #Stdnts
+Total number of students attempted the problem.
+
+=item Tries
+Total number of tries for solving the problem.
-HELP This needs to be localized, or at least generated automatically.
+=item Max Tries
+Largest number of tries for solving the problem by a student.
+
+=item Mean
+Average number of tries. [ Tries / #Stdnts ]
+
+=item #YES
+Number of students solved the problem correctly.
+
+=item #yes
+Number of students solved the problem by override.
+
+=item %Wrong
+Percentage of students who tried to solve the problem
+but is still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]
+
+=item DoDiff
+Degree of Difficulty of the problem.
+[ 1 - ((#YES+#yes) / Tries) ]
+
+=item S.D.
+Standard Deviation of the tries.
+[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1)
+where Xi denotes every student\'s tries ]
+
+=item Skew.
+Skewness of the students tries.
+[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]
+
+=item Dis.F.
+Discrimination Factor: A Standard for evaluating the
+problem according to a Criterion<br>
+
+=item [Criterion to group students into %27 Upper Students -
+and %27 Lower Students]
+1st Criterion for Sorting the Students:
+Sum of Partial Credit Awarded / Total Number of Tries
+2nd Criterion for Sorting the Students:
+Total number of Correct Answers / Total Number of Tries
+
+=item Disc.
+Number of Students had at least one discussion.
+
+=back
=cut
-###############################################
-###############################################
-sub ProblemStatisticsLegend {
- my $Ptr = '';
- $Ptr = '<table border="0">';
- $Ptr .= '<tr><td>';
- $Ptr .= '<b>#Stdnts</b></td>';
- $Ptr .= '<td>Total number of students attempted the problem.';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>Tries</b></td>';
- $Ptr .= '<td>Total number of tries for solving the problem.';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>Max Tries</b></td>';
- $Ptr .= '<td>Largest number of tries for solving the problem by a student.';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>Mean</b></td>';
- $Ptr .= '<td>Average number of tries. [ Tries / #Stdnts ]';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>#YES</b></td>';
- $Ptr .= '<td>Number of students solved the problem correctly.';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>#yes</b></td>';
- $Ptr .= '<td>Number of students solved the problem by override.';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>%Wrong</b></td>';
- $Ptr .= '<td>Percentage of students who tried to solve the problem ';
- $Ptr .= 'but is still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>DoDiff</b></td>';
- $Ptr .= '<td>Degree of Difficulty of the problem. ';
- $Ptr .= '[ 1 - ((#YES+#yes) / Tries) ]';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>S.D.</b></td>';
- $Ptr .= '<td>Standard Deviation of the tries. ';
- $Ptr .= '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) ';
- $Ptr .= 'where Xi denotes every student\'s tries ]';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>Skew.</b></td>';
- $Ptr .= '<td>Skewness of the students tries.';
- $Ptr .= '[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]';
- $Ptr .= '</td></tr><tr><td>';
- $Ptr .= '<b>Dis.F.</b></td>';
- $Ptr .= '<td>Discrimination Factor: A Standard for evaluating the ';
- $Ptr .= 'problem according to a Criterion<br>';
- $Ptr .= '<b>[Criterion to group students into %27 Upper Students - ';
- $Ptr .= 'and %27 Lower Students]</b><br>';
- $Ptr .= '<b>1st Criterion</b> for Sorting the Students: ';
- $Ptr .= '<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>';
- $Ptr .= '<b>2nd Criterion</b> for Sorting the Students: ';
- $Ptr .= '<b>Total number of Correct Answers / Total Number of Tries</b>';
- $Ptr .= '</td></tr>';
- $Ptr .= '<tr><td><b>Disc.</b></td>';
- $Ptr .= '<td>Number of Students had at least one discussion.';
- $Ptr .= '</td></tr></table>';
- return $Ptr;
+
+############################################################
+############################################################
+##
+## How this all works:
+## Statistics are computed by calling &get_statistics with the sequence,
+## resource, and part id to run statistics on. At various places within
+## the loops which compute the statistics, as well as before and after
+## the entire process, subroutines can be called. The subroutines are
+## registered to the following hooks:
+##
+## hook subroutine inputs
+## ----------------------------------------------------------
+## pre $r,$count
+## pre_seq $r,$count,$seq
+## pre_res $r,$count,$seq,$res
+## calc $r,$count,$seq,$res,$data
+## post_res $r,$count,$seq,$res
+## post_seq $r,$count,$seq
+## post $r,$count
+##
+## abort $r
+##
+## subroutines will be called in the order in which they are registered.
+##
+############################################################
+############################################################
+{
+
+my %hooks;
+my $aborted = 0;
+
+sub abort_computation {
+ $aborted = 1;
+}
+
+sub clear_hooks {
+ $aborted = 0;
+ undef(%hooks);
+}
+
+sub register_hook {
+ my ($hookname,$subref)=@_;
+ if ($hookname !~ /^(pre|pre_seq|pre_res|post|post_seq|post_res|calc)$/){
+ return;
+ }
+ if (ref($subref) ne 'CODE') {
+ &Apache::lonnet::logthis('attempt to register hook to non-code: '.
+ $hookname,' = '.$subref);
+ } else {
+ if (exists($hooks{$hookname})) {
+ push(@{$hooks{$hookname}},$subref);
+ } else {
+ $hooks{$hookname} = [$subref];
+ }
+ }
+ return;
+}
+
+sub run_hooks {
+ my $context = shift();
+ foreach my $hook (@{$hooks{$context}}) {
+ if ($aborted && $context ne 'abort') {
+ last;
+ }
+ my $retvalue = $hook->(@_);
+ if (defined($retvalue) && $retvalue eq '0') {
+ $aborted = 1 if (! $aborted);
+ }
+ }
}
-#---- END Problem Statistics Web Page ----------------------------------------
+sub run_statistics {
+ my ($r) = @_;
+ my $count = 0;
+ &run_hooks('pre',$r,$count);
+ foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+ last if ($aborted);
+ next if ($seq->{'num_assess'}<1);
+ &run_hooks('pre_seq',$r,$count,$seq);
+ foreach my $res (@{$seq->{'contents'}}) {
+ last if ($aborted);
+ next if ($res->{'type'} ne 'assessment');
+ &run_hooks('pre_res',$r,$count,$seq,$res);
+ foreach my $part (@{$res->{'parts'}}) {
+ last if ($aborted);
+ #
+ # This is where all the work happens
+ my $data = &get_statistics($seq,$res,$part,++$count);
+ &run_hooks('calc',$r,$count,$seq,$res,$part,$data);
+ }
+ &run_hooks('post_res',$r,$count,$seq,$res);
+ }
+ &run_hooks('post_seq',$r,$count,$seq);
+ }
+ if ($aborted) {
+ &run_hooks('abort',$r);
+ } else {
+ &run_hooks('post',$r,$count);
+ }
+ return;
+}
+
+} # End of %hooks scope
+
+############################################################
+############################################################
1;
__END__
--matthew1080338662--