--- loncom/interface/statistics/lonproblemanalysis.pm 2003/03/03 21:52:24 1.20
+++ 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.20 2003/03/03 21:52:24 albertel Exp $
+# $Id: lonproblemanalysis.pm,v 1.103 2004/11/10 16:56:39 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -24,578 +24,1956 @@
#
# http://www.lon-capa.org/
#
-# (Navigate problems for statistical reports
-# YEAR=2002
-# 5/12,7/26,9/7,11/22 Behrouz Minaei
-#
-###
-
package Apache::lonproblemanalysis;
use strict;
use Apache::lonnet();
+use Apache::loncommon();
use Apache::lonhtmlcommon();
-use GDBM_File;
-
-my $jr;
+use Apache::loncoursedata();
+use Apache::lonstatistics;
+use Apache::lonlocal;
+use Apache::lonstathelpers();
+use Apache::lonstudentsubmissions();
+use HTML::Entities();
+use Time::Local();
+use Spreadsheet::WriteExcel();
+
+my $plotcolors = ['#33ff00',
+ '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
+ '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
+ ];
+
+my @SubmitButtons = ({ name => 'PrevProblemAnalysis',
+ text => 'Previous Problem' },
+ { name => 'ProblemAnalysis',
+ text => 'Analyze Problem Again' },
+ { name => 'NextProblemAnalysis',
+ text => 'Next Problem' },
+ { name => 'break'},
+ { name => 'SelectAnother',
+ text => 'Choose a different Problem' },
+ { name => 'ExcelOutput',
+ text => 'Produce Excel Output' });
sub BuildProblemAnalysisPage {
- my ($cacheDB, $r)=@_;
-
- my %cache;
- unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
- $r->print('Unable to tie database.');
- return;
- }
-
- my $Ptr = '';
- $Ptr .= '
';
- $Ptr .= 'Select Sections';
- $Ptr .= ' | '."\n";
- $Ptr .= ''."\n";
- my @sectionsSelected = split(':',$cache{'sectionsSelected'});
- my @sections = split(':',$cache{'sectionList'});
- $Ptr .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
- $Ptr .= ' |
'."\n";
- $Ptr .= 'Intervals | '."\n";
- $Ptr .= '';
- $Ptr .= &IntervalOptions($cache{'Interval'});
- $Ptr .= ' |
';
- $r->print($Ptr);
+ my ($r,$c)=@_;
+ #
+ my %Saveable_Parameters = ('Status' => 'scalar',
+ 'Section' => 'array',
+ 'NumPlots' => 'scalar',
+ 'AnalyzeOver' => 'scalar',
+ );
+ &Apache::loncommon::store_course_settings('problem_analysis',
+ \%Saveable_Parameters);
+ &Apache::loncommon::restore_course_settings('problem_analysis',
+ \%Saveable_Parameters);
+ #
+ &Apache::lonstatistics::PrepareClasslist();
+ #
+ $r->print(&CreateInterface());
+ #
+ my @Students = @Apache::lonstatistics::Students;
+ #
+ if (@Students < 1 && exists($ENV{'form.firstrun'})) {
+ $r->print('There are no students in the sections selected
');
+ }
+ #
+ my @CacheButtonHTML =
+ &Apache::lonstathelpers::manage_caches($r,'Statistics','stats_status');
$r->rflush();
-# $r->print($cache{'OptionResponses'}.'
');
- $r->print(&OptionResponseTable($cache{'OptionResponses'}, \%cache, $r));
-
- untie(%cache);
+ #
+ # 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) {
+ if ($button->{'name'} eq 'break') {
+ $r->print("
\n");
+ } else {
+ $r->print('{'text'}).'" />');
+ $r->print(' 'x5);
+ }
+ }
+ foreach my $html (@CacheButtonHTML) {
+ $r->print($html.(' 'x5));
+ }
+ #
+ $r->print('
');
+ $r->rflush();
+ #
+ # Determine which problem we are to analyze
+ my $current_problem = &Apache::lonstathelpers::get_target_from_id
+ ($ENV{'form.problemchoice'});
+ #
+ my ($prev,$curr,$next) =
+ &Apache::lonstathelpers::get_prev_curr_next($current_problem,
+ $problem_types,
+ 'response',
+ );
+ if (exists($ENV{'form.PrevProblemAnalysis'}) && defined($prev)) {
+ $current_problem = $prev;
+ } elsif (exists($ENV{'form.NextProblemAnalysis'}) && defined($next)) {
+ $current_problem = $next;
+ } else {
+ $current_problem = $curr;
+ }
+ #
+ # Store the current problem choice and send it out in the form
+ $ENV{'form.problemchoice'} =
+ &Apache::lonstathelpers::make_target_id($current_problem);
+ $r->print('');
+ #
+ if (! defined($current_problem->{'resource'})) {
+ $r->print('resource is undefined');
+ } else {
+ my $resource = $current_problem->{'resource'};
+ $r->print(''.$resource->{'title'}.'
');
+ $r->print(''.$resource->{'src'}.'
');
+ 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 $problem_data = $Data{$current_problem->{'part'}.
+ '.'.
+ $current_problem->{'respid'}};
+ if ($current_problem->{'resptype'} eq 'option') {
+ &OptionResponseAnalysis($r,$current_problem,
+ $problem_data,
+ \@Students);
+ } elsif ($current_problem->{'resptype'} eq 'radiobutton') {
+ &radio_response_analysis($r,$current_problem,
+ $problem_data,
+ \@Students);
+ } elsif ($current_problem->{'resptype'} eq 'numerical') {
+ &numerical_response_analysis($r,$current_problem,
+ $problem_data,\@Students);
+ } else {
+ $r->print('Analysis of '.$current_problem->{'resptype'}.' is not supported
');
+ }
+ }
+ $r->print('
');
+ } else {
+ $r->print('');
+ $r->print(' 'x5);
+ $r->print(''.&mt('Please select a problem to analyze').'
');
+ $r->print(&Apache::lonstathelpers::ProblemSelector
+ ($problem_types));
+ }
+}
+#########################################################
+#########################################################
+##
+## Numerical Response Routines
+##
+#########################################################
+#########################################################
+sub numerical_response_analysis {
+ my ($r,$problem,$problem_analysis,$students) = @_;
+ my $c = $r->connection();
+ #
+ if ($ENV{'form.AnalyzeOver'} !~ /^(tries|time)$/) {
+ $r->print('Bad request');
+ }
+ #
+ my ($resource,$partid,$respid) = ($problem->{'resource'},
+ $problem->{'part'},
+ $problem->{'respid'});
+ # Gather student data
+ my $response_data = &Apache::loncoursedata::get_response_data
+ (\@Apache::lonstatistics::SelectedSections,
+ $Apache::lonstatistics::enrollment_status,
+ $resource->{'symb'},$respid);
+ #
+ for (my $plot_num = 1;$plot_num<=$ENV{'form.NumPlots'};$plot_num++) {
+ my $restriction_function;
+ $restriction_function = sub {($_[0]->{'tries'} == $plot_num?1:0)};
+ #
+ my ($correct,$intervals,$answers) =
+ &numerical_response_determine_intervals($r,$resource,$partid,
+ $respid,$students);
+ if ($c->aborted()) { return; };
+ #
+ my $responses = &classify_response_data($response_data,
+ $correct,
+ $restriction_function);
+ my $student_count = $responses->{'_students'};
+ my $correct_count = $responses->{'_correct'};
+ my $total_count = $responses->{'_count'};
+ my $max = $responses->{'_max'};
+ #
+ my $analysis_html = ''.&mt('Attempt [_1]',$plot_num).'
';
+ $analysis_html.= &numerical_one_dimensional_plot($r,600,150,
+ scalar(@$students),
+ $answers);
+ $analysis_html.= ''.
+ ''.
+ &numerical_plot_percent($r,$responses).' | '.
+ ''.
+ &numerical_plot_differences($r,$responses).' | '.
+ '
'.$/.'
';
+ $r->print($analysis_html);
+ }
+ #
return;
}
-sub BuildAnalyzePage {
- my ($cacheDB, $students, $courseID,$r)=@_;
-
- $jr = $r;
- my $c = $r->connection;
-
- my $Str = '';
- my %cache;
-
- unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
- $Str .= 'Unable to tie database.';
- $r->print($Str);
- return;
+sub numerical_plot_percent {
+ my ($r,$responses) = @_;
+ #
+ 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);
}
-
- # Remove students who don't have the proper section.
- my @sectionsSelected = split(':',$cache{'sectionsSelected'});
-
- my $studentCount = scalar @$students;
- for(my $studentIndex=$studentCount-1; $studentIndex>=0;
- $studentIndex--) {
- my $value = $cache{$students->[$studentIndex].':section'};
- my $found = 0;
- foreach (@sectionsSelected) {
- if($_ eq 'none') {
- if($value eq '' || !defined($value) || $value eq ' ') {
- $found = 1;
- last;
- }
+ 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 {
- if($value eq $_) {
- $found = 1;
- last;
- }
+ $incorrect[$bin]+=$count;
}
}
- if($found == 0) {
- splice(@$students, $studentIndex, 1);
- }
}
- unless(untie(%cache)) {
- $r->print('Can not untie hash.');
- $r->rflush();
+ #
+ 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;
+}
- &Apache::lonhtmlcommon::Close_PrgWin($r);
+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;
+}
-### jason code for checing is there data in cache
-# my $error =
-# &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
-# 'true',
-# $cacheDB,
-# 'true',
-# 'true',
-# $courseID,
-# $r, $c);
-# if($error ne 'OK') {
-# $r->print($error.'
Error downloading course data
');
-# return;
-# }
-
- unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
- $Str .= 'Unable to tie database.';
- $r->print($Str);
- return;
+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);
+}
- my ($problemId, $part, $responseId)=split(':',$cache{'AnalyzeInfo'});
- my $uri = $cache{$problemId.':source'};
- my $problem = $cache{$problemId.':problem'};
- my $title = $cache{$problemId.':title'};
- my $interval = $cache{'Interval'};
- my $heading = 'Restore this particular Option Response Problem '.
- 'Results, Please wait...';
-
- my %ConceptData;
- $ConceptData{"Interval"} = $interval;
-
- #Initialize the option response true answers
- my ($analyzeData) = &InitAnalysis($uri, $part, $responseId, $problem,
- $students->[0], $courseID);
- if(defined($analyzeData->{'error'})) {
- $Str .= $analyzeData->{'error'}.'
Incorrect part requested.
';
- $r->print($Str);
- return;
+sub numerical_one_dimensional_plot {
+ my ($r,$width,$height,$n,$data)=@_;
+ #
+ # Compute data -> image scaling factors
+ my $max_y = 0;
+ 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);
+ $ticscale = 1 if ($ticscale < 1);
+ }
+ #
+ # Create the plot
+ my $plot =
+ qq{};
+ 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_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');
+ $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 .= '';
+ my $plotresult = &Apache::lonxml::xmlparse($r,'web',$plot);
+
+ my $result = ''.
+ ''.
+ ''.&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_x.' | '.
+ ''.$plotresult.' | '.
+ ''.$max_x.' | '.
+ '
'.
+ '
';
+ return $result;
+}
- $r->print($Str);
- $Str = '';
- if($c->aborted()) { untie(%cache); return; }
-
- #compute the intervals
- &Interval($part, $problem, $interval, $analyzeData->{'concepts'},
- \%ConceptData);
-
- $title =~ s/\ /"_"/eg;
- $Str .= '
'.$uri.'';
-
- $r->print($Str);
- $Str = '';
- if($c->aborted()) { untie(%cache); return; }
-
-
- my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, $title,
- $heading,$#students+1);
-
- #Java script Progress window
- for(my $index=0; $index<(scalar @$students); $index++) {
- if($c->aborted()) { untie(%cache); return; }
- &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
- 'last student '.$students->[$index]);
- &OpStatus($problemId, $students->[$index], \%ConceptData,
- $analyzeData->{'foil_to_concept'}, $analyzeData,
- \%cache, $courseID);
- }
- &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
-
- $Str .= '
';
- for (my $k=0; $k<$interval; $k++ ) {
- if($c->aborted()) { untie(%cache); return $Str; }
- $Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'},
- \%ConceptData);
- $r->print($Str);
- $Str = '';
- }
- for (my $k=0; $k<$interval; $k++ ) {
- if($c->aborted()) { untie(%cache); return $Str; }
- $Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData);
- $r->print($Str);
- $Str = '';
- }
- my $Answ=&Apache::lonnet::ssi($uri);
- $Str .= '
Here you can see the Problem:
'.$Answ;
- $Str .= '