[LON-CAPA-cvs] cvs: loncom /interface/statistics lonproblemanalysis.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Fri, 12 Mar 2004 20:29:49 -0000
matthew Fri Mar 12 15:29:49 2004 EDT
Modified files:
/loncom/interface/statistics lonproblemanalysis.pm
Log:
Reworked analysis of numerical responses. Uses <drawimage> and &xmlparse
to create a chart of answers.
Index: loncom/interface/statistics/lonproblemanalysis.pm
diff -u loncom/interface/statistics/lonproblemanalysis.pm:1.77 loncom/interface/statistics/lonproblemanalysis.pm:1.78
--- loncom/interface/statistics/lonproblemanalysis.pm:1.77 Thu Mar 11 15:11:18 2004
+++ loncom/interface/statistics/lonproblemanalysis.pm Fri Mar 12 15:29:48 2004
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonproblemanalysis.pm,v 1.77 2004/03/11 20:11:18 matthew Exp $
+# $Id: lonproblemanalysis.pm,v 1.78 2004/03/12 20:29:48 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -99,7 +99,7 @@
}
$r->rflush();
#
- my $problem_types = '(option|radiobutton)';
+ my $problem_types = '(option|radiobutton|numerical)';
if (exists($ENV{'form.problemchoice'}) &&
! exists($ENV{'form.SelectAnother'})) {
foreach my $button (@SubmitButtons) {
@@ -161,11 +161,11 @@
\@Students);
} elsif ($current_problem->{'resptype'} eq 'numerical') {
# if (exists($ENV{'form.ExcelOutput'})) {
- &Apache::lonstudentsubmissions::prepare_excel_output
- ($r,$current_problem,$ProblemData,\@Students);
+# &Apache::lonstudentsubmissions::prepare_excel_output
+# ($r,$current_problem,$ProblemData,\@Students);
# } else {
-# &NumericalResponseAnalysis($r,$current_problem,
-# $ProblemData,\@Students);
+ &NumericalResponseAnalysis($r,$current_problem,
+ $ProblemData,\@Students);
# }
} else {
$r->print('<h2>This analysis is not supported</h2>');
@@ -192,7 +192,6 @@
#########################################################
sub NumericalResponseAnalysis {
my ($r,$problem,$ProblemData,$Students) = @_;
- $r->print('<h2>This analysis is not yet supported</h2>');
my ($resource,$respid) = ($problem->{'resource'},
$problem->{'respid'});
my $analysis_html;
@@ -207,40 +206,110 @@
$r->print($analysis_html);
return;
}
+ #
+ # This next call causes all the waiting around that people complain about
my ($max,$min) = &GetStudentAnswers($r,$problem,$Students);
- $r->print('Maximum = '.$max.' Minimum = '.$min);
- my $max_students = 0;
+ #
+ # Collate the data
my %Data;
foreach my $student (@$Students) {
my $answer = $student->{'answer'};
$Data{$answer}++;
- if ($max_students < $Data{$answer}) {
- $max_students = $Data{$answer};
- }
- }
- foreach (5,10,20,25,50,75,100,150,200,250,500,1000,1500,2000,2500,5000) {
- if ($max_students < $_) {
- $max_students = $_;
- last;
- }
}
my @Labels = sort {$a <=> $b } keys(%Data);
- $r->print('number of labels = '.scalar(@Labels));
my @PlotData = @Data{@Labels};
- $r->print('number of PlotData = '.scalar(@PlotData));
- my $graph =
- &Apache::loncommon::DrawXYGraph('Correct Answer Distribution',
- 'Correct Answer',
- 'Number of students',
- $max_students,
- undef,
- \@Labels,
- [\@PlotData],
- (xskip=>10));
- $r->print($graph);
+ #
+ 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)=@_;
+ #
+ # Compute data -> image scaling factors
+ my $min = $Labels->[0];
+ my $max = $Labels->[-1];
+ my $h_scale = ($width-10)/($max-$min);
+ #
+ my $max_y = 0;
+ foreach (@$Data) {
+ $max_y = $_ if ($max_y < $_);
+ }
+ my $ticscale = 5;
+ if ($max_y * $ticscale > $height/2) {
+ $ticscale = int($height/2/$max_y);
+ $ticscale = 1 if ($ticscale < 1);
+ }
+ #
+ # Create the plot
+ my $plot =
+ qq{<drawimage width="$width" height="$height" bgcolor="transparent" >};
+ for (my $idx=0;$idx<scalar(@$Labels);$idx++) {
+ my $xloc = 5+$h_scale*($Labels->[$idx] - $min);
+ my $top = $height/2-$Data->[$idx]*$ticscale;
+ my $bottom = $height/2+$Data->[$idx]*$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
+ my $r = 4;
+ $plot .= &line(5,$height/2,$circle_x-$r,$height/2,'000000',1);
+ $plot .= &circle($circle_x,$height/2,$r+1,'000000');
+ $plot .= &line($circle_x+$r,$height/2,$width-5,$height/2,'000000',1);
+ } else {
+ $plot .= &line(5,$height/2,$width-5,$height/2,'000000',1);
+ }
+ $plot .= '</drawimage>';
+ my $plotresult = &Apache::lonxml::xmlparse($r,'web',$plot);
+
+ my $title = 'Distribution of correct answers';
+ my $result = '<table>'.
+ '<tr><td colspan="3" align="center">'.
+ '<font size="+2">'.$title.' (N='.$N.')'.
+ '</font>'.
+ '</td></tr>'.
+ '<tr>'.
+ '<td valign="center">'.$min.'</td>'.
+ '<td>'.$plotresult.'</td>'.
+ '<td valign="center">'.$max.'</td>'.
+ '</tr>'.
+ '<tr><td colspan="3" align="center">'.
+ 'Maximum Number of Coinciding Values: '.$max_y.
+ '</td></tr>'.
+ '</table>';
+ return $result;
+}
+
+##
+## Helper subroutines for <drawimage>.
+## These should probably go somewhere more suitable soon.
+sub line {
+ my ($x1,$y1,$x2,$y2,$color,$thickness) = @_;
+ return qq{<line x1="$x1" y1="$y1" x2="$x2" y2="$y2" color="$color" thickness="$thickness" />$/};
+}
+
+sub rectangle {
+ my ($x1,$y1,$x2,$y2,$color,$thickness,$filled) = @_;
+ return qq{<rectangle x1="$x1" y1="$y1" x2="$x2" y2="$y2" color="$color" thickness="$thickness" filled="$filled" />};
+}
+
+sub arc {
+ my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)=@_;
+ return qq{<arc x="$x" y="$y" width="$width" height="$height" start="$start" end="$end" color="$color" thickness="$thickness" filled="$filled" />};
+}
+
+sub circle {
+ my ($x,$y,$radius,$color,$thickness,$filled)=@_;
+ return &arc($x,$y,$radius,$radius,0,360,$color,$thickness,$filled);
+}
+
sub GetStudentAnswers {
my ($r,$problem,$Students) = @_;
my %Answers;
@@ -541,7 +610,8 @@
my $mintries = 1;
my $maxtries = $ENV{'form.NumPlots'};
my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
- if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) {
+ if (! defined($Concepts) ||
+ ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils'))) {
$table = '<h3>'.
&mt('Not enough data for concept analysis. '.
'Performing Foil Analysis').