--- loncom/interface/statistics/lonproblemanalysis.pm 2004/06/04 21:42:18 1.85
+++ loncom/interface/statistics/lonproblemanalysis.pm 2004/11/10 16:56:39 1.103
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonproblemanalysis.pm,v 1.85 2004/06/04 21:42:18 matthew Exp $
+# $Id: lonproblemanalysis.pm,v 1.103 2004/11/10 16:56:39 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -56,14 +56,12 @@ my @SubmitButtons = ({ name => 'PrevProb
{ name => 'ExcelOutput',
text => 'Produce Excel Output' });
-
sub BuildProblemAnalysisPage {
my ($r,$c)=@_;
#
my %Saveable_Parameters = ('Status' => 'scalar',
'Section' => 'array',
'NumPlots' => 'scalar',
- 'AnalyzeAs' => 'scalar',
'AnalyzeOver' => 'scalar',
);
&Apache::loncommon::store_course_settings('problem_analysis',
@@ -77,7 +75,7 @@ sub BuildProblemAnalysisPage {
#
my @Students = @Apache::lonstatistics::Students;
#
- if (@Students < 1) {
+ if (@Students < 1 && exists($ENV{'form.firstrun'})) {
$r->print('
There are no students in the sections selected
');
}
#
@@ -85,7 +83,10 @@ sub BuildProblemAnalysisPage {
&Apache::lonstathelpers::manage_caches($r,'Statistics','stats_status');
$r->rflush();
#
- my $problem_types = '(option|radiobutton|numerical)';
+ # Support for numerical and radio response isn't complete enough to
+ # include in 1.2 release.
+ # my $problem_types = '(option|radiobutton|numerical)';
+ my $problem_types = '.';#(option)';
if (exists($ENV{'form.problemchoice'}) &&
! exists($ENV{'form.SelectAnother'})) {
foreach my $button (@SubmitButtons) {
@@ -133,35 +134,28 @@ sub BuildProblemAnalysisPage {
my $resource = $current_problem->{'resource'};
$r->print('
'.$resource->{'title'}.'
');
$r->print('
'.$resource->{'src'}.'
');
- $r->print(&Apache::lonstathelpers::render_resource($resource));
+ if ($ENV{'form.show_prob'} eq 'true') {
+ $r->print(&Apache::lonstathelpers::render_resource($resource));
+ }
$r->rflush();
my %Data = &Apache::lonstathelpers::get_problem_data
($resource->{'src'});
- my $ProblemData = $Data{$current_problem->{'part'}.
+ my $problem_data = $Data{$current_problem->{'part'}.
'.'.
$current_problem->{'respid'}};
if ($current_problem->{'resptype'} eq 'option') {
&OptionResponseAnalysis($r,$current_problem,
- $ProblemData,
+ $problem_data,
\@Students);
} elsif ($current_problem->{'resptype'} eq 'radiobutton') {
- &RadioResponseAnalysis($r,$current_problem,
- $ProblemData,
- \@Students);
+ &radio_response_analysis($r,$current_problem,
+ $problem_data,
+ \@Students);
} elsif ($current_problem->{'resptype'} eq 'numerical') {
- ##
- ## analyze all responses of a problem at once
- my $res = $current_problem->{'resource'};
- foreach my $partid (@{$res->{'parts'}}) {
- $current_problem->{'part'} = $partid;
- foreach my $respid (@{$res->{'partdata'}->{$partid}->{'ResponseIds'}}) {
- $current_problem->{'respid'}=$respid;
- &NumericalResponseAnalysis($r,$current_problem,
- $ProblemData,\@Students);
- }
- }
+ &numerical_response_analysis($r,$current_problem,
+ $problem_data,\@Students);
} else {
- $r->print('
This analysis is not supported
');
+ $r->print('
Analysis of '.$current_problem->{'resptype'}.' is not supported
');
}
}
$r->print('');
@@ -175,7 +169,6 @@ sub BuildProblemAnalysisPage {
}
}
-
#########################################################
#########################################################
##
@@ -183,80 +176,273 @@ sub BuildProblemAnalysisPage {
##
#########################################################
#########################################################
-sub NumericalResponseAnalysis {
- my ($r,$problem,$ProblemData,$Students) = @_;
+sub numerical_response_analysis {
+ my ($r,$problem,$problem_analysis,$students) = @_;
my $c = $r->connection();
- my ($resource,$partid,$respid) = ($problem->{'resource'},
- $problem->{'part'},
- $problem->{'respid'});
#
- if (scalar(@{$resource->{'parts'}})>1) {
- if (@{$resource->{'partdata'}->{$partid}->{'ResponseIds'}}>1) {
- $r->print('
';
$r->print($analysis_html);
- return;
}
#
- # This next call causes all the waiting around that people complain about
- my ($max,$min) =
- &Apache::lonstathelpers::GetStudentAnswers($r,$problem,$Students,
- 'Statistics',
- 'stats_status');
- return if ($c->aborted());
- #
- # Collate the data
- my %Data;
- foreach my $student (@$Students) {
- my $answer = $student->{'answer'};
- $Data{$answer}++;
- }
- my @Labels = sort {$a <=> $b } keys(%Data);
- my @PlotData = @Data{@Labels};
- #
- my $width = 500;
- my $height = 100;
- my $plot = &one_dimensional_plot($r,500,100,scalar(@$Students),
- \@Labels,\@PlotData);
- $r->print($plot);
return;
}
-sub one_dimensional_plot {
- my ($r,$width,$height,$N,$Labels,$Data)=@_;
+sub numerical_plot_percent {
+ my ($r,$responses) = @_;
#
- # Compute data -> image scaling factors
- my $min = $Labels->[0];
- my $max = $Labels->[-1];
- if ($max == $min) {
- $max =$min+1;
+ my $total = $responses->{'_count'};
+ return '' if ($total == 0);
+ my $minbin = 0.5;
+ while (my ($interval,$submissions) = each(%$responses)) {
+ next if ($interval =~ /^_/);
+ my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+ my $low_percent = abs(($ans-$ans_low)/$ans);
+ my $high_percent = abs(($ans_high-$ans)/$ans);
+ if ($minbin > $high_percent) { $minbin = $high_percent; }
+ if ($minbin > $low_percent) { $minbin = $low_percent; }
+ }
+ #
+ my @bins;
+ if ($minbin < 1) {
+ @bins = (0.1, ".5",1,1.5,2,2.5,3,4,5,10,20,50,100);
+ } elsif ($minbin < 2) {
+ @bins = (0.5,1,1.5,2,2.5,3,4,5,10,20,50,100);
+ } elsif ($minbin < 5) {
+ @bins = (1,2,3,4,5,10,25,50,75,100,200);
+ } elsif ($minbin < 10) {
+ @bins = (2,4,6,8,10,12,15,20,25,30,50,75,100,200);
+ } else {
+ @bins = (5,10,15,20,25,30,50,75,100,200);
+ }
+ my @labels = (1..scalar(@bins));
+ #
+ my @correct;
+ my @incorrect;
+ while (my ($interval,$submissions) = each(%$responses)) {
+ next if ($interval =~ /^_/);
+ my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+ while (my ($submission,$count) = each(%$submissions)) {
+ my $scaled_value = abs(($submission-$ans)/$ans);
+ my $bin=0;
+ for ($bin=0;$bin<$#bins;$bin++) { # not <= for a reason
+ last if ($bins[$bin]>$scaled_value);
+ }
+ if (($submission <= $ans_high) && ($submission >= $ans_low)) {
+ $correct[$bin]+=$count;
+ } else {
+ $incorrect[$bin]+=$count;
+ }
+ }
}
- my $h_scale = ($width-10)/($max-$min);
#
+ for (my $i=0;$i<=$#bins;$i++) {
+ if (! defined( $correct[$i])) { $correct[$i]=0;}
+ if (! defined($incorrect[$i])) { $incorrect[$i]=0;}
+ $correct[$i]*=100/$total;
+ $incorrect[$i]*=100/$total;
+ }
+ my $title = &mt('Distribution by Percent');
+ my $graph = &Apache::loncommon::DrawBarGraph
+ ($title,'Percent difference from correct','Number of answers',
+ 100,['#33FF00','#FF3300'],\@labels,\@correct,\@incorrect,
+ {xskip=>1});
+ #
+ my $table = $graph.'
'.&mt('Bar').'
'.
+ '
'.&mt('Range').'
';
+ for (my $i=0;$i<=$#bins;$i++) {
+ my $lownum;
+ if ($i == 0) {
+ $lownum = 0;
+ } else {
+ $lownum = $bins[$i-1];
+ }
+ my $highnum = $bins[$i];
+ $table .=
+ '
'.
+ '
'.$labels[$i].'
'.
+ '
'.$lownum.'
'.
+ '
-
'.
+ '
'.$highnum.'
'.'
'.$/;
+ }
+ $table.= '
'.$/;
+ return $table;
+}
+
+sub numerical_plot_differences {
+ my ($r,$responses) = @_;
+ #
+ my $total = $responses->{'_count'};
+ return '' if ($total == 0);
+ my $minbin = undef;
+ my $maxbin = undef;
+ while (my ($interval,$submissions) = each(%$responses)) {
+ next if ($interval =~ /^_/);
+ my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+ my $low_diff = abs($ans-$ans_low);
+ my $high_diff = abs($ans_high-$ans);
+ if (! defined($maxbin)) { $maxbin = $low_diff;}
+ if (! defined($minbin)) { $minbin = $low_diff;}
+ #
+ if ($minbin > $high_diff) { $minbin = $high_diff; }
+ if ($minbin > $low_diff ) { $minbin = $low_diff; }
+ #
+ if ($maxbin < $high_diff) { $maxbin = $high_diff; }
+ if ($maxbin < $low_diff ) { $maxbin = $low_diff; }
+ }
+ #
+ my @bins;
+ my @labels;
+ # Hmmmm, should switch to absolute difference
+ for (my $i=1;$i<=20;$i++) {
+ push(@bins,$i*$minbin/2);
+ push(@labels,$i);
+ }
+ #
+ my @correct;
+ my @incorrect;
+ while (my ($interval,$submissions) = each(%$responses)) {
+ next if ($interval =~ /^_/);
+ my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+ while (my ($submission,$count) = each(%$submissions)) {
+ my $value = abs($submission-$ans);
+ my $bin=0;
+ for ($bin=0;$bin<$#bins;$bin++) { # not <= for a reason
+ last if ($bins[$bin]>$value);
+ }
+ if (($submission <= $ans_high) && ($submission >= $ans_low)) {
+ $correct[$bin]+=$count;
+ } else {
+ $incorrect[$bin]+=$count;
+ }
+ }
+ }
+ #
+ for (my $i=0;$i<=$#bins;$i++) {
+ if (! defined( $correct[$i])) { $correct[$i]=0;}
+ if (! defined($incorrect[$i])) { $incorrect[$i]=0;}
+ $correct[$i]*=100/$total;
+ $incorrect[$i]*=100/$total;
+ }
+ my $title = &mt('Distribution by Magnitude');
+ my $graph = &Apache::loncommon::DrawBarGraph
+ ($title,'magnitude difference from correct','Number of answers',
+ 100,['#33FF00','#FF3300'],\@labels,\@correct,\@incorrect,{xskip=>1});
+ #
+ my $table = $graph.'
'.&mt('Bar').'
'.
+ '
'.&mt('Range').'
';
+ for (my $i=0;$i<=$#bins;$i++) {
+ my $lownum;
+ if ($i == 0) {
+ $lownum = 0;
+ } else {
+ $lownum = $bins[$i-1];
+ }
+ my $highnum = $bins[$i];
+ $table .=
+ '
'.
+ '
'.$labels[$i].'
'.
+ '
'.$lownum.'
'.
+ '
-
'.
+ '
'.$highnum.'
'.'
'.$/;
+ }
+ $table.= '
'.$/;
+ return $table;
+}
+
+sub numerical_response_determine_intervals {
+ my ($r,$resource,$partid,$respid,$students)=@_;
+ my $c = $r->connection();
+ #
+ # FIX ME: Need progress dialog updates
+ #
+ # Read in the cache (if it exists) before we start timing things.
+ &Apache::lonstathelpers::ensure_proper_cache($resource->{'symb'});
+ #
+ my $correct;
+ # %intervals differs from %answers because it may be possible for two
+ # students to have the same correct answer but different intervals.
+ my %intervals;
+ my %answers;
+ foreach my $student (@$students) {
+ last if ($c->aborted());
+ my $sname = $student->{'username'};
+ my $sdom = $student->{'domain'};
+ # analyze problem
+ my $analysis =
+ &Apache::lonstathelpers::analyze_problem_as_student($resource,
+ $sname,
+ $sdom);
+ # make the key
+ my $key = $partid.'.'.$respid;
+ my $interval = join(' ',($analysis->{$key.'.answer'}->[0],
+ $analysis->{$key.'.ans_low'}->[0],
+ $analysis->{$key.'.ans_high'}->[0]));
+ $correct->{$sname.':'.$sdom} = $interval;
+ $intervals{$interval}++;
+ $answers{$analysis->{$key.'.answer'}->[0]}++;
+ }
+ &Apache::lonstathelpers::write_analysis_cache();
+ return ($correct,\%intervals,\%answers);
+}
+
+sub numerical_one_dimensional_plot {
+ my ($r,$width,$height,$n,$data)=@_;
+ #
+ # Compute data -> image scaling factors
my $max_y = 0;
- foreach (@$Data) {
- $max_y = $_ if ($max_y < $_);
+ my $min_x = undef;
+ my $max_x = undef;
+ while (my ($answer,$count) = each(%$data)) {
+ $max_y = $count if ($max_y < $count);
+ if (! defined($min_x) || $answer < $min_x) {
+ $min_x = $answer;
+ }
+ if (! defined($max_x) || $answer > $max_x) {
+ $max_x = $answer;
+ }
}
+ #
+ my $h_scale = ($width-10)/($max_x-$min_x);
+ #
my $ticscale = 5;
if ($max_y * $ticscale > $height/2) {
$ticscale = int($height/2/$max_y);
@@ -266,17 +452,16 @@ sub one_dimensional_plot {
# Create the plot
my $plot =
qq{};
- for (my $idx=0;$idx[$idx] - $min);
- my $top = $height/2-$Data->[$idx]*$ticscale;
- my $bottom = $height/2+$Data->[$idx]*$ticscale;
- $plot .=
- &line($xloc,$top,$xloc,$bottom,'888888',1);
+ while (my ($answer,$count) = each(%$data)) {
+ my $xloc = 5+$h_scale*($answer - $min_x);
+ my $top = $height/2-$count*$ticscale;
+ my $bottom = $height/2+$count*$ticscale;
+ $plot .= &line($xloc,$top,$xloc,$bottom,'888888',1);
}
#
# Put the scale on last to ensure it is on top of the data.
- if ($min < 0 && $max > 0) {
- my $circle_x = 5+$h_scale*abs($min); # '0' in data coordinates
+ if ($min_x < 0 && $max_x > 0) {
+ my $circle_x = 5+$h_scale*abs($min_x); # '0' in data coordinates
my $r = 4;
$plot .= &line(5,$height/2,$circle_x-$r,$height/2,'000000',1);
$plot .= &circle($circle_x,$height/2,$r+1,'000000');
@@ -287,20 +472,18 @@ sub one_dimensional_plot {
$plot .= '';
my $plotresult = &Apache::lonxml::xmlparse($r,'web',$plot);
- my $title = 'Distribution of correct answers';
my $result = '
'.
'
'.
- ''.$title.' (N='.$N.')'.
- ''.
+ ''.&mt('Distribution of correct answers').''.
+ ' '.&mt('[_1] students, [_2] distinct correct answers',
+ $n,scalar(keys(%$data))).
+ ' '.&mt('Maximum number of coinciding values: [_1]',$max_y).
'
'.
'
'.
- '
'.$min.'
'.
+ '
'.$min_x.'
'.
'
'.$plotresult.'
'.
- '
'.$max.'
'.
+ '
'.$max_x.'
'.
'
'.
- '
'.
- 'Maximum Number of Coinciding Values: '.$max_y.
- '
'.
'
';
return $result;
}
@@ -310,7 +493,7 @@ sub one_dimensional_plot {
## These should probably go somewhere more suitable soon.
sub line {
my ($x1,$y1,$x2,$y2,$color,$thickness) = @_;
- return qq{$/};
+ return qq{};
}
sub text {
@@ -373,185 +556,431 @@ sub build_student_data_worksheet {
##
#########################################################
#########################################################
-sub RadioResponseAnalysis {
- my ($r,$problem,$ProblemData,$Students) = @_;
- my ($resource,$respid) = ($problem->{'resource'},
- $problem->{'respid'});
+sub radio_response_analysis {
+ my ($r,$problem,$problem_analysis,$students) = @_;
+ #
+ if ($ENV{'form.AnalyzeOver'} !~ /^(tries|time)$/) {
+ $r->print('Bad request');
+ }
+ #
+ my ($resource,$partid,$respid) = ($problem->{'resource'},
+ $problem->{'part'},
+ $problem->{'respid'});
+ #
my $analysis_html;
- my $PerformanceData = &Apache::loncoursedata::get_response_data
+ my $foildata = $problem_analysis->{'_Foils'};
+ my ($table,$foils,$concepts) = &build_foil_index($problem_analysis);
+ #
+ my %true_foils;
+ my $num_true = 0;
+ if (! $problem_analysis->{'answercomputed'}) {
+ foreach my $foil (@$foils) {
+ if ($foildata->{$foil}->{'value'} eq 'true') {
+ $true_foils{$foil}++;
+ }
+ }
+ $num_true = scalar(keys(%true_foils));
+ }
+ #
+ $analysis_html .= $table;
+ # Gather student data
+ my $response_data = &Apache::loncoursedata::get_response_data
(\@Apache::lonstatistics::SelectedSections,
$Apache::lonstatistics::enrollment_status,
$resource->{'symb'},$respid);
- if (! defined($PerformanceData) ||
- ref($PerformanceData) ne 'ARRAY' ) {
+ my $correct; # either a hash reference or a scalar
+ if ($problem_analysis->{'answercomputed'} || scalar(@$concepts) > 1) {
+ # This takes a while for large classes...
+ &Apache::lonstathelpers::GetStudentAnswers($r,$problem,$students,
+ 'Statistics',
+ 'stats_status');
+ foreach my $student (@$students) {
+ my ($idx,@remainder) = split('&',$student->{'answer'});
+ my ($answer) = ($remainder[$idx]=~/^(.*)=([^=]*)$/);
+ $correct->{$student->{'username'}.':'.$student->{'domain'}}=
+ &Apache::lonnet::unescape($answer);
+ }
+ } else {
+ foreach my $foil (keys(%$foildata)) {
+ if ($foildata->{$foil}->{'value'} eq 'true') {
+ $correct = $foildata->{$foil}->{'name'};
+ }
+ }
+ }
+ #
+ if (! defined($response_data) || ref($response_data) ne 'ARRAY' ) {
$analysis_html = '
'.
&mt('There is no submission data for this resource').
'