--- loncom/interface/statistics/lonproblemanalysis.pm 2003/03/03 21:52:24 1.20
+++ loncom/interface/statistics/lonproblemanalysis.pm 2004/10/05 14:03:45 1.93
@@ -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.93 2004/10/05 14:03:45 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -24,578 +24,1499 @@
#
# 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);
-
- 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;
- }
-
- # 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;
- }
+ #
+ # 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 {
- if($value eq $_) {
- $found = 1;
- last;
- }
+ $r->print('{'text'}).'" />');
+ $r->print(' 'x5);
}
}
- if($found == 0) {
- splice(@$students, $studentIndex, 1);
+ foreach my $html (@CacheButtonHTML) {
+ $r->print($html.(' 'x5));
}
- }
- unless(untie(%cache)) {
- $r->print('Can not untie hash.');
+ #
+ $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') {
+ &RadioResponseAnalysis($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,
+ $problem_data,\@Students);
+ }
+ }
+ } else {
+ $r->print('This analysis 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));
}
+}
- &Apache::lonhtmlcommon::Close_PrgWin($r);
-### 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);
+#########################################################
+#########################################################
+##
+## Numerical Response Routines
+##
+#########################################################
+#########################################################
+sub NumericalResponseAnalysis {
+ my ($r,$problem,$problem_data,$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(''.
+ &mt('Part [_1], response [_2].',$partid,$respid).
+ '
');
+ } else {
+ $r->print(''.
+ &mt('Part [_1]',$partid,$respid).
+ '
');
+ }
+ } elsif (@{$resource->{'partdata'}->{$partid}->{'ResponseIds'}}>1) {
+ $r->print(''.&mt('Response [_1]',$respid).'
');
+ }
+ #
+ my $analysis_html;
+ my $PerformanceData = &Apache::loncoursedata::get_response_data
+ (\@Apache::lonstatistics::SelectedSections,
+ $Apache::lonstatistics::enrollment_status,
+ $resource->{'symb'},$respid);
+ if (! defined($PerformanceData) ||
+ ref($PerformanceData) ne 'ARRAY' ) {
+ $analysis_html = ''.
+ &mt('There is no submission data for this resource').
+ '
';
+ $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;
+}
- 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 one_dimensional_plot {
+ my ($r,$width,$height,$N,$Labels,$Data)=@_;
+ #
+ # Compute data -> image scaling factors
+ my $min = $Labels->[0];
+ my $max = $Labels->[-1];
+ if ($max == $min) {
+ $max =$min+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{};
+ 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);
+ }
+ #
+ # 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 .= '';
+ my $plotresult = &Apache::lonxml::xmlparse($r,'web',$plot);
+
+ my $title = 'Distribution of correct answers';
+ my $result = ''.
+ ''.
+ ''.$title.' (N='.$N.')'.
+ ''.
+ ' |
'.
+ ''.
+ ''.$min.' | '.
+ ''.$plotresult.' | '.
+ ''.$max.' | '.
+ '
'.
+ ''.
+ 'Maximum Number of Coinciding Values: '.$max_y.
+ ' |
'.
+ '
';
+ 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 .= '