--- loncom/interface/statistics/lonproblemanalysis.pm 2002/11/25 18:12:52 1.15
+++ loncom/interface/statistics/lonproblemanalysis.pm 2003/10/16 15:24:49 1.41
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
-# (Publication Handler
#
-# $Id: lonproblemanalysis.pm,v 1.15 2002/11/25 18:12:52 minaeibi Exp $
+
+# $Id: lonproblemanalysis.pm,v 1.41 2003/10/16 15:24:49 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,582 +25,773 @@
#
# 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 HTML::Entities();
+
+my $plotcolors = ['#33ff00',
+ '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
+ '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
+ ];
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::lonhtmlcommon::MultipleSectionSelect(\@sections,
- \@sectionsSelected,
- 'Statistics');
- $Ptr .= ' '."\n";
- $Ptr .= 'Intervals '."\n";
- $Ptr .= '';
- $Ptr .= &IntervalOptions($cache{'Interval'});
- $Ptr .= '
';
- $r->print($Ptr);
- $r->rflush();
- $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;
+ my ($r,$c)=@_;
+ $r->print(''.&mt('Option Response Problem Analysis').' ');
+ $r->print(&CreateInterface());
+ #
+ my @Students = @Apache::lonstatistics::Students;
+ #
+ if (exists($ENV{'form.ClearCache'}) ||
+ exists($ENV{'form.updatecaches'}) ||
+ (exists($ENV{'form.firstanalysis'}) &&
+ $ENV{'form.firstanalysis'} ne 'no')) {
+ &Apache::lonstatistics::Gather_Full_Student_Data($r);
}
-
- # 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;
+ if (! exists($ENV{'form.firstanalysis'})) {
+ $r->print(' ');
+ } else {
+ $r->print(' ');
+ }
+ $r->rflush();
+ if (exists($ENV{'form.problemchoice'}) &&
+ ! exists($ENV{'form.SelectAnother'})) {
+ $r->print(' ');
+ $r->print(' 'x5);
+ $r->print(' ');
+ $r->print(' 'x5);
+ $r->print(' ');
+ $r->print(' 'x5);
+ $r->print(' ');
+ $r->print(' ');
+ $r->print(' 'x5);
+ #
+ $r->print(' ');
+ #
+ my ($symb,$part,$resid) = &get_problem_symb(
+ &Apache::lonnet::unescape($ENV{'form.problemchoice'})
+ );
+ #
+ my $resource = &get_resource_from_symb($symb);
+ if (defined($resource)) {
+ $r->print(''.$resource->{'src'}.' ');
+ my %Data = &get_problem_data($resource->{'src'});
+ my $ORdata = $Data{$part.'.'.$resid};
+ ##
+ ## Render the problem
+ my $base;
+ ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
+ $base = "http://".$ENV{'SERVER_NAME'}.$base;
+ my $rendered_problem =
+ &Apache::lonnet::ssi_body($resource->{'src'});
+ $rendered_problem =~ s/<\s*form\s*/)|<\/nop>|g;
+ $r->print(''.
+ ' '.
+ $rendered_problem.
+ '
');
+ ##
+ ## Analyze the problem
+ my $PerformanceData =
+ &Apache::loncoursedata::get_optionresponse_data
+ (\@Students,$symb,$resid);
+ if (defined($PerformanceData) &&
+ ref($PerformanceData) eq 'ARRAY') {
+ if ($ENV{'form.AnalyzeOver'} eq 'Tries') {
+ my $analysis_html = &tries_analysis($PerformanceData,
+ $ORdata);
+ $r->print($analysis_html);
+ } elsif ($ENV{'form.AnalyzeOver'} eq 'Time') {
+ my $analysis_html = &time_analysis($PerformanceData,
+ $ORdata);
+ $r->print($analysis_html);
+ } else {
+ $r->print(''.
+ &mt('The analysis you have selected is '.
+ 'not supported at this time').
+ ' ');
}
} else {
- if($value eq $_) {
- $found = 1;
- last;
+ $r->print(''.
+ &mt('There is no student data for this problem.').
+ ' ');
+ }
+ } else {
+ $r->print('resource is undefined');
+ }
+ $r->print(' ');
+ } else {
+ $r->print(' ');
+ $r->print(' 'x5);
+ $r->print(''.&mt('Please select a problem to analyze').' ');
+ $r->print(&OptionResponseProblemSelector());
+ }
+}
+
+
+#########################################################
+#########################################################
+##
+## Misc interface routines use by analysis code
+##
+#########################################################
+#########################################################
+sub build_foil_index {
+ my ($ORdata) = @_;
+ return if (! exists($ORdata->{'Foils'}));
+ my %Foildata = %{$ORdata->{'Foils'}};
+ my @Foils = sort(keys(%Foildata));
+ my %Concepts;
+ foreach my $foilid (@Foils) {
+ push(@{$Concepts{$Foildata{$foilid}->{'Concept'}}},
+ $foilid);
+ }
+ undef(@Foils);
+ # Having gathered the concept information in a hash, we now translate it
+ # into an array because we need to be consistent about order.
+ # Also put the foils in order, too.
+ my $sortfunction = sub {
+ my %Numbers = (one => 1,
+ two => 2,
+ three => 3,
+ four => 4,
+ five => 5,
+ six => 6,
+ seven => 7,
+ eight => 8,
+ nine => 9,
+ ten => 10,);
+ my $a1 = $a;
+ my $b1 = $b;
+ if (exists($Numbers{lc($a)})) {
+ $a1 = $Numbers{lc($a)};
+ }
+ if (exists($Numbers{lc($b)})) {
+ $b1 = $Numbers{lc($b)};
+ }
+ $a1 cmp $b1;
+ };
+ my @Concepts;
+ foreach my $concept (sort $sortfunction (keys(%Concepts))) {
+ push(@Concepts,{ name => $concept,
+ foils => [@{$Concepts{$concept}}]});
+ push(@Foils,(@{$Concepts{$concept}}));
+ }
+ #
+ # Build up the table of row labels.
+ my $table = ''."\n";
+ if (@Concepts > 1) {
+ $table .= ''.
+ ''.&mt('Concept Number').' '.
+ ''.&mt('Concept').' '.
+ ''.&mt('Foil Number').' '.
+ ''.&mt('Foil Name').' '.
+ ''.&mt('Foil Text').' '.
+ ''.&mt('Correct Value').' '.
+ " \n";
+ } else {
+ $table .= ''.
+ ''.&mt('Foil Number').' '.
+ ''.&mt('Foil Name').' '.
+ ''.&mt('Foil Text').' '.
+ ''.&mt('Correct Value').' '.
+ " \n";
+ }
+ my $conceptindex = 1;
+ my $foilindex = 1;
+ foreach my $concept (@Concepts) {
+ my @FoilsInConcept = @{$concept->{'foils'}};
+ my $firstfoil = shift(@FoilsInConcept);
+ if (@Concepts > 1) {
+ $table .= ''.
+ ''.$conceptindex.' '.
+ ''.$concept->{'name'}.' '.
+ ''.$foilindex++.' '.
+ ''.$Foildata{$firstfoil}->{'name'}.' '.
+ ''.$Foildata{$firstfoil}->{'text'}.' '.
+ ''.$Foildata{$firstfoil}->{'value'}.' '.
+ " \n";
+ } else {
+ $table .= ''.
+ ''.$foilindex++.' '.
+ ''.$Foildata{$firstfoil}->{'name'}.' '.
+ ''.$Foildata{$firstfoil}->{'text'}.' '.
+ ''.$Foildata{$firstfoil}->{'value'}.' '.
+ " \n";
+ }
+ foreach my $foilid (@FoilsInConcept) {
+ if (@Concepts > 1) {
+ $table .= ''.
+ ' '.
+ ' '.
+ ''.$foilindex.' '.
+ ''.$Foildata{$foilid}->{'name'}.' '.
+ ''.$Foildata{$foilid}->{'text'}.' '.
+ ''.$Foildata{$foilid}->{'value'}.' '.
+ " \n";
+ } else {
+ $table .= ''.
+ ''.$foilindex.' '.
+ ''.$Foildata{$foilid}->{'name'}.' '.
+ ''.$Foildata{$foilid}->{'text'}.' '.
+ ''.$Foildata{$foilid}->{'value'}.' '.
+ " \n";
+ }
+ } continue {
+ $foilindex++;
+ }
+ } continue {
+ $conceptindex++;
+ }
+ $table .= "
\n";
+ #
+ # Build option index with color stuff
+ return ($table,\@Foils,\@Concepts);
+}
+
+sub build_option_index {
+ my ($ORdata)= @_;
+ my $table = "\n";
+ my $optionindex = 0;
+ my @Rows;
+ foreach my $option (&mt('correct option chosen'),@{$ORdata->{'Options'}}) {
+ push (@Rows,
+ ''.
+ ''.
+ (' 'x4).' '.
+ ''.$option.' '.
+ " \n");
+ }
+ $table .= join('',reverse(@Rows));
+ $table .= "
\n";
+}
+
+#########################################################
+#########################################################
+##
+## Tries Analysis
+##
+#########################################################
+#########################################################
+sub tries_analysis {
+ my ($PerformanceData,$ORdata) = @_;
+ my $mintries = 1;
+ my $maxtries = $ENV{'form.NumPlots'};
+ my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
+ if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) {
+ $table = ''.
+ &mt('Not enough data for concept analysis. '.
+ 'Performing Foil Analysis').
+ ' '.$table;
+ $ENV{'form.AnalyzeAs'} = 'Foils';
+ }
+ my %ResponseData = &analyze_option_data_by_tries($PerformanceData,
+ $mintries,$maxtries);
+ #
+ # Compute the data neccessary to make the plots
+ my @PlotData; # Array which holds the data for each plot
+ # @{$PlotData[$try]->{'datasetname'}} holds the data for
+ # try $try with respect to 'datasetname'. The array is
+ # filled either with per-foil or per-concept data.
+ my ($extrakey,$xlabel,$ylabel);
+ if ($ENV{'form.AnalyzeAs'} eq 'Foils') {
+ $extrakey = &build_option_index($ORdata);
+ $xlabel = 'Foil Number';
+ $ylabel = 'Percent Choosing Option';
+ foreach my $foilid (@$Foils) {
+ for (my $i=$mintries;$i<=$maxtries;$i++) {
+ foreach my $option ('_correct',@{$ORdata->{'Options'}}) {
+ push(@{$PlotData[$i]->{'_total'}},
+ $ResponseData{$foilid}->[$i]->{'_total'});
+ if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) {
+ push (@{$PlotData[$i]->{$option}},0);
+ } else {
+ push (@{$PlotData[$i]->{$option}},
+ 100 * $ResponseData{$foilid}->[$i]->{$option} /
+ $ResponseData{$foilid}->[$i]->{'_total'});
+ }
}
}
}
- if($found == 0) {
- splice(@$students, $studentIndex, 1);
+ } else {
+ # Concept analysis
+ #
+ # Note: we do not bother with characterizing the students incorrect
+ # answers at the concept level because an incorrect answer for one foil
+ # may be a correct answer for another foil.
+ $extrakey = '';
+ $xlabel = 'Concept Number';
+ $ylabel = 'Percent Correct';
+ my %ConceptData;
+ foreach my $concept (@{$Concepts}) {
+ for (my $i=$mintries;$i<=$maxtries;$i++) {
+ #
+ # Gather the per-attempt data
+ my $cdata = $ConceptData{$concept}->[$i];
+ foreach my $foilid (@{$concept->{'foils'}}) {
+ $cdata->{'_correct'} +=
+ $ResponseData{$foilid}->[$i]->{'_correct'};
+ $cdata->{'_total'} +=
+ $ResponseData{$foilid}->[$i]->{'_total'};
+ }
+ push (@{$PlotData[$i]->{'_total'}},$cdata->{'_total'});
+ if ($cdata->{'_total'} == 0) {
+ push (@{$PlotData[$i]->{'_correct'}},0);
+ } else {
+ push (@{$PlotData[$i]->{'_correct'}},
+ 100*$cdata->{'_correct'}/$cdata->{'_total'});
+ }
+ }
}
- }
- unless(untie(%cache)) {
- $r->print('Can not untie hash.');
- $r->rflush();
- }
- #if($status eq 'true')
- { &Apache::lonhtmlcommon::Close_PrgWin($r); }
-
-
-# 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;
- }
-
- 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 $title = 'LON-CAPA Statistics';
- 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;
- }
-
- $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; }
-
- &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
-
- my $count=0;
- #Java script Progress window
- for(my $index=0; $index<(scalar @$students); $index++) {
- if($c->aborted()) { untie(%cache); return; }
- $count++;
- my $displayString = $count.'/'.$studentCount.': '.$_;
- &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
- &OpStatus($problemId, $students->[$index], \%ConceptData,
- $analyzeData->{'foil_to_concept'}, $analyzeData,
- \%cache, $courseID);
- }
- &Apache::lonhtmlcommon::Close_PrgWin($r);
-
- $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 .= '