--- loncom/interface/statistics/lonproblemanalysis.pm 2002/07/24 14:52:32 1.1
+++ loncom/interface/statistics/lonproblemanalysis.pm 2004/12/06 16:22:21 1.108
@@ -1,7 +1,6 @@
# The LearningOnline Network with CAPA
-# (Publication Handler
#
-# $Id: lonproblemanalysis.pm,v 1.1 2002/07/24 14:52:32 stredwic Exp $
+# $Id: lonproblemanalysis.pm,v 1.108 2004/12/06 16:22:21 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,364 +24,2122 @@
#
# http://www.lon-capa.org/
#
-# (Navigate problems for statistical reports
-# YEAR=2001
-# 5/5,7/9,7/25/1,8/11,9/13,9/26,10/5,10/9,10/22,10/26 Behrouz Minaei
-# 11/1,11/4,11/16,12/14,12/16,12/18,12/20,12/31 Behrouz Minaei
-# YEAR=2002
-# 1/22,2/1,2/6,2/25,3/2,3/6,3/17,3/21,3/22,3/26,4/7,5/6 Behrouz Minaei
-# 5/12,5/14,5/15,5/19,5/26,7/16 Behrouz Minaei
-#
-###
-
-package Apache::lonproblemanalysis;
+package Apache::lonproblemanalysis;
use strict;
use Apache::lonnet();
-use GDBM_File;
+use Apache::loncommon();
+use Apache::lonhtmlcommon();
+use Apache::loncoursedata();
+use Apache::lonstatistics;
+use Apache::lonlocal;
+use Apache::lonstathelpers();
+use Apache::lonstudentsubmissions();
+use HTML::Entities();
+use Time::Local();
+use Spreadsheet::WriteExcel();
+use capa;
+
+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)=@_;
+ 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();
+ #
+ # 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));
+ }
+}
- my %cache;
- my $Str = '';
- unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
- $Str .= 'Unable to tie database.';
- return $Str;
+#########################################################
+#########################################################
+##
+## 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);
+ #
+ $problem_analysis->{'answercomputed'} = 1;
+ if ($problem_analysis->{'answercomputed'}) {
+ my $answers =
+ &Apache::lonstathelpers::GetStudentAnswers($r,$problem,$students,
+ 'Statistics',
+ 'stats_status');
+ $r->print(&numerical_one_dimensional_plot($r,600,150,$answers));
+ }
+ #
+ if (ref($response_data) ne 'ARRAY') {
+ $r->print(''.
+ &mt('There is no submission data for this resource').
+ '
');
+ return;
+ }
+ my $analysis_html = '';
+ for (my $plot_num = 1;$plot_num<=$ENV{'form.NumPlots'};$plot_num++) {
+ my $restriction_function;
+ my $header_message;
+ my $stats_message;
+ my $post_message; # passed through &mt sooner rather than later
+ my $no_data_message;
+ my @extra_data;
+ if ($ENV{'form.AnalyzeOver'} eq 'tries') {
+ $restriction_function = sub {($_[0]->{'tries'} == $plot_num?1:0)};
+ $header_message = 'Attempt [_1]';
+ $stats_message =
+ '[_1] submissions, [_2] correct, [_3] incorrect';
+ $post_message = '';
+ $no_data_message = 'No data exists for attempt [_1]';
+ } else {
+ my $starttime = &Apache::lonhtmlcommon::get_date_from_form
+ ('startdate_'.$plot_num);
+ my $endtime = &Apache::lonhtmlcommon::get_date_from_form
+ ('enddate_'.$plot_num);
+ ($starttime,$endtime) = &ensure_start_end_times
+ ($starttime,$endtime,
+ &get_time_from_row($response_data->[0]),
+ &get_time_from_row($response_data->[-1]),
+ $plot_num);
+ $header_message = 'Data from [_2] to [_3]';
+ $extra_data[0] = &Apache::lonlocal::locallocaltime($starttime);
+ $extra_data[1] = &Apache::lonlocal::locallocaltime($endtime);
+ #
+ $stats_message =
+ '[_1] submissions from [_4] students, [_2] correct, [_3] incorrect';
+ #
+ $post_message =
+ &mt('Start time: [_1]',
+ &Apache::lonhtmlcommon::date_setter
+ ('Statistics','startdate_'.$plot_num,$starttime)).
+ '
'.
+ &mt('End time: [_1]',
+ &Apache::lonhtmlcommon::date_setter
+ ('Statistics','enddate_'.$plot_num,$endtime));
+ $restriction_function =
+ sub {
+ my $t = $_[0]->{'timestamp'};
+ if ($t >= $starttime && $t < $endtime) {
+ return 1;
+ } else {
+ return 0;
+ }
+ };
+ $no_data_message = 'No data for [_2] to [_3]';
+ }
+ #
+ my ($correct,$answers) =
+ &numerical_determine_answers($r,$resource,$partid,
+ $respid,$students);
+ if ($c->aborted()) { return; };
+ #
+ my $responses = &numerical_classify_responses($response_data,$correct,
+ $restriction_function);
+ if ($responses->{'_count'} == 0) {
+ $analysis_html.=
+ ''.
+ &mt($no_data_message,$plot_num,@extra_data).
+ ' |
';
+ } else {
+ $analysis_html.=
+ ''.
+ &mt($header_message,$plot_num,@extra_data).
+ ' |
'.
+ ''.
+ &mt($stats_message,
+ $responses->{'_count'},
+ $responses->{'_correct'},
+ $responses->{'_count'}-$responses->{'_correct'},
+ $responses->{'_students'},
+ @extra_data).
+ ' |
'.
+ ''.''.
+ &numerical_plot_percent($r,$responses).' | '.
+ ''.
+ &numerical_plot_differences($r,$responses).' | '.
+ '
';
+ }
+ if ($post_message ne '') {
+ $analysis_html .=
+ ''.$post_message.' |
';
+ }
}
+ $analysis_html.='
';
+ $r->print($analysis_html);
+ #
+ return;
+}
- $Str .= &IntervalOptions($cache{'Interval'});
- $Str .= &OptionResponseTable($cache{'OptionResponses'});
+sub numerical_plot_percent {
+ my ($r,$responses) = @_;
+ #
+ my $total = $responses->{'_count'};
+ return '' if ($total == 0);
+ my $minbin = 5;
+ while (my ($interval,$submissions) = each(%$responses)) {
+ next if ($interval =~ /^_/);
+ my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+ my $low_percent = abs(100*($ans-$ans_low)/$ans);
+ my $high_percent = abs(100*($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','0.5','1.0','1.5','2.0','2.5','3.0','4.0','5.0',10,20,50,100);
+ } elsif ($minbin < 2) {
+ @bins = ('0.5','1.0','1.5','2.0','2.5','3.0','4.0','5.0',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;
+ my @count;
+ while (my ($interval,$submissions) = each(%$responses)) {
+ next if ($interval =~ /^_/);
+ my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+ while (my ($submission,$counts) = each(%$submissions)) {
+ my ($correct_count,$incorrect_count) = @$counts;
+ 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);
+ }
+ $correct[$bin]+=$correct_count;
+ $incorrect[$bin]+=$incorrect_count;
+ $count[$bin]+=$correct_count+$incorrect_count;
+ }
+ }
+ #
+ my @plot_correct;
+ my @plot_incorrect;
+ for (my $i=0;$i<=$#bins;$i++) {
+ $plot_correct[$i] = $correct[$i]*100/$total;
+ $plot_incorrect[$i] = $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,\@plot_correct,\@plot_incorrect,
+ {xskip=>1});
+ #
+ my $table = $graph.$/.
+ &numerical_bin_table(\@bins,\@labels,\@incorrect,\@correct,\@count).$/;
+ return $table;
+}
- untie(%cache);
+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;
+ my @count;
+ while (my ($interval,$submissions) = each(%$responses)) {
+ next if ($interval =~ /^_/);
+ my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+ while (my ($submission,$counts) = each(%$submissions)) {
+ my ($correct_count,$incorrect_count) = @$counts;
+ my $value = abs($submission-$ans);
+ my $bin=0;
+ for ($bin=0;$bin<$#bins;$bin++) { # not <= for a reason
+ last if ($bins[$bin]>$value);
+ }
+ $correct[$bin]+=$correct_count;
+ $incorrect[$bin]+=$incorrect_count;
+ $count[$bin]+=$correct_count+$incorrect_count;
+ }
+ }
+ #
+ my @plot_correct;
+ my @plot_incorrect;
+ for (my $i=0;$i<=$#bins;$i++) {
+ $plot_correct[$i] = $correct[$i]*100/$total;
+ $plot_incorrect[$i] = $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,\@plot_correct,\@plot_incorrect,
+ {xskip=>1});
+ #
+ my $table = $graph.$/.
+ &numerical_bin_table(\@bins,\@labels,\@incorrect,\@correct,\@count).$/;
+ return $table;
+}
- return $Str;
+sub numerical_classify_responses {
+ &Apache::lonnet::logthis('--------------');
+ my ($full_row_data,$correct,$function) = @_;
+ my %submission_data;
+ my %students;
+ my $max=0;
+ foreach my $row (@$full_row_data) {
+# &Apache::lonnet::logthis(' row = '.join(',',@$row));
+ my %subm = &hashify_attempt($row);
+ if (ref($correct) eq 'HASH') {
+ $subm{'correct'} = $correct->{$subm{'student'}}->{'answer'};
+ $subm{'unit'} = $correct->{$subm{'student'}}->{'unit'};
+ } else { # This probably never happens....
+ $subm{'correct'} = $correct->{'answer'};
+ $subm{'unit'} = $correct->{'unit'};
+ }
+ $subm{'submission'} =~ s/=\d+\s*$//;
+ if (&$function(\%subm)) {
+ my $scaled = '1';
+ my ($sname,$sdom) = split(':',$subm{'student'});
+ # Note that $subm{'unit'} is modified by the following call
+ # We do not use it again but you should be aware just in case.
+# my ($myunit,$mysub) = ($subm{'unit'},$subm{'submission'});
+# $myunit = 'm';
+# # &Apache::lonnet::logthis($myunit);
+# my $result =
+# &capa::caparesponse_get_real_response($myunit,
+# $mysub,
+# \$scaled);
+# # &Apache::lonnet::logthis(' '.$myunit.':'.$subm{'unit'}.
+# # ' '.$mysub.':'.$subm{'submission'}.'; '.$result);
+# next if (! defined($scaled));
+# next if ($result ne '6');
+# my $submission = $scaled;
+ my $submission = $subm{'submission'};
+ $students{$subm{'student'}}++;
+ if (&numerical_submission_is_correct($subm{'award'})) {
+ &Apache::lonnet::logthis('correct:'.$submission.':'.$subm{'correct'});
+ $submission_data{'_correct'}++;
+ $submission_data{'_count'}++;
+ $submission_data{$subm{'correct'}}->{$submission}->[0]++;
+ } elsif (&numerical_submission_is_incorrect($subm{'award'})) {
+ &Apache::lonnet::logthis('incorrect:'.$submission.':'.$subm{'correct'});
+ $submission_data{'_count'}++;
+ $submission_data{$subm{'correct'}}->{$submission}->[1]++;
+ }
+ my $value =
+ $submission_data{$subm{'correct'}}->{$submission}->[0]+
+ $submission_data{$subm{'correct'}}->{$submission}->[1];
+ if ($max < $value) { $max = $value; }
+ }
+ }
+ $submission_data{'_max'} = $max;
+ $submission_data{'_students'}=scalar(keys(%students));
+ return \%submission_data;
}
-sub BuildAnalyzePage {
- my ($cacheDB, $students, $courseID)=@_;
+sub numerical_submission_is_correct {
+ my ($award) = @_;
+ &Apache::lonnet::logthis('award = "'.$award.'"');
+ if ($award =~ /^(APPROX_ANS|EXACT_ANS)$/) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
- my $Str = '';
- my %cache;
- unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) {
- $Str .= 'Unable to tie database.';
- return $Str;
- }
-
- my $uri = $cache{'AnalyzeURI'},
- my $part = $cache{'AnalyzePart'},
- my $problem = $cache{'AnalyzeProblem'},
- my $title = $cache{'AnalyzeTitle'},
- my $interval = $cache{'Interval'},
-
- my %ConceptData;
- $ConceptData{"Interval"} = $interval;
-
- #Initialize the option response true answers
- my ($Concepts, $foil_to_concept, $answer) = &InitAnalysis($uri, $part,
- $problem,
- $students->[0],
- $courseID);
-
- #compute the intervals
- &Interval($part, $problem, $interval, $Concepts, \%ConceptData);
-
- $title =~ s/\ /"_"/eg;
- $Str .= '
'.$uri.'';
-
- #Java script Progress window
- &Create_PrgWin();
- &Update_PrgWin("Starting-to-analyze-problem");
- for (my $index=0;$index<(scalar @$students);$index++) {
- &Update_PrgWin($index);
- &OpStatus($problem, $students->[$index], $courseID, $answer);
- }
- &Close_PrgWin();
-
- $Str .= '
';
- for (my $k=0; $k<$interval; $k++ ) {
- $Str .= &DrawGraph($k, $title, $Concepts, \%ConceptData);
- }
- for (my $k=0; $k<$interval; $k++ ) {
- $Str .= &DrawTable($k, $Concepts, \%ConceptData);
- }
-#$Apache::lonxml::debug=1;
-#&Apache::lonhomework::showhash(%ConceptData);
-#$Apache::lonxml::debug=0;
- my $Answ=&Apache::lonnet::ssi($uri);
- $Str .= '
Here you can see the Problem:
'.$Answ;
+sub numerical_submission_is_incorrect {
+ my ($award) = @_;
+ if ($award =~ /^(INCORRECT)$/) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
- untie(%cache);
+sub numerical_bin_table {
+ my ($bins,$labels,$incorrect,$correct,$count)=@_;
+ my $table =
+ ''.&mt('Bar').' | '.
+ ''.&mt('Range').' | '.
+ ''.&mt('Incorrect').' | '.
+ ''.&mt('Correct').' | '.
+ ''.&mt('Count').' | '.
+ '
'.$/;
+ for (my $i=0;$i[$i-1];
+ }
+ my $highnum = $bins->[$i];
+ $table .=
+ ''.
+ ''.$labels->[$i].' | '.
+ ''.$lownum.' | '.
+ ' - | '.
+ ''.$highnum.' | '.
+ ''.$incorrect->[$i].' | '.
+ ''.$correct->[$i].' | '.
+ ''.$count->[$i].' | '.
+ '
'.$/;
+ }
+ $table.= '
';
+ return $table;
+}
- return $Str;
+sub numerical_determine_answers {
+ my ($r,$resource,$partid,$respid,$students)=@_;
+ my $c = $r->connection();
+ #
+ # FIX ME: May 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;
+ 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;
+ $correct->{$sname.':'.$sdom}->{'answer'} =
+ $analysis->{$key.'.answer'}->[0];
+ $correct->{$sname.':'.$sdom}->{'unit'} =
+ $analysis->{$key.'.unit'}->[0];
+ $answers{$analysis->{$key.'.answer'}->[0]}++;
+ }
+ &Apache::lonstathelpers::write_analysis_cache();
+ return ($correct,\%answers);
}
-#---- Problem Analysis Web Page ----------------------------------------------
+#
+# Inputs: $r, $width, $height, $data
+# $n = number of students
+# $data = hashref of $answer => $frequency pairs
+sub numerical_one_dimensional_plot {
+ my ($r,$width,$height,$data)=@_;
+ #
+ # Compute data -> image scaling factors
+ my $max_y = 0;
+ my $min_x = undef;
+ my $max_x = undef;
+ my $n = 0;
+ while (my ($answer,$count) = each(%$data)) {
+ $n+=$count;
+ $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 $min_max_difference = $max_x - $min_x;
+ if (! defined($min_max_difference) || $min_max_difference == 0) {
+ $min_max_difference = 1;
+ }
+ my $h_scale = ($width-10)/$min_max_difference;
+ #
+ 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;
+}
+
+##
+## Helper subroutines for .
+## These should probably go somewhere more suitable soon.
+sub line {
+ my ($x1,$y1,$x2,$y2,$color,$thickness) = @_;
+ return qq{};
+}
+
+sub text {
+ my ($x,$y,$color,$text,$font,$direction) = @_;
+ if (! defined($font) || $font !~ /^(tiny|small|medium|large|giant)$/) {
+ $font = 'medium';
+ }
+ if (! defined($direction) || $direction ne 'vertical') {
+ $direction = '';
+ }
+ return qq{$text};
+}
+
+sub rectangle {
+ my ($x1,$y1,$x2,$y2,$color,$thickness,$filled) = @_;
+ return qq{};
+}
+
+sub arc {
+ my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)=@_;
+ return qq{};
+}
+
+sub circle {
+ my ($x,$y,$radius,$color,$thickness,$filled)=@_;
+ return &arc($x,$y,$radius,$radius,0,360,$color,$thickness,$filled);
+}
-sub IntervalOptions {
- my ($selectedInterval)=@_;
+#########################################################
+#########################################################
+##
+## Radio Response Routines
+##
+#########################################################
+#########################################################
+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 $foildata = $problem_analysis->{'_Foils'};
+ my ($table,$foils,$concepts) = &build_foil_index($problem_analysis);
+ if (! defined($concepts)) {
+ $concepts = [];
+ }
+ #
+ 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);
+ 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').
+ '
';
+ $r->print($analysis_html);
+ return;
+ }
+ #
+ $analysis_html.='';
+ for (my $plot_num = 1;$plot_num<=$ENV{'form.NumPlots'};$plot_num++) {
+ # classify data ->correct foil -> selected foil
+ my ($restriction_function,
+ $correct_foil_title,$incorrect_foil_title,
+ $pre_graph_text,$post_graph_text,
+ $no_data_text,@extra_data);
+ if ($ENV{'form.AnalyzeOver'} eq 'tries') {
+ $restriction_function = sub {($_[0]->{'tries'} == $plot_num?1:0)};
+ $correct_foil_title = 'Attempt '.$plot_num;
+ $incorrect_foil_title = 'Attempt '.$plot_num;
+ $pre_graph_text =
+ 'Attempt [_1], [_2] submissions, [_3] correct, [_4] incorrect';
+ $post_graph_text = '';
+ $no_data_text = 'No data exists for attempt [_1]';
+ } elsif ($ENV{'form.AnalyzeOver'} eq 'time') {
+ my $starttime = &Apache::lonhtmlcommon::get_date_from_form
+ ('startdate_'.$plot_num);
+ my $endtime = &Apache::lonhtmlcommon::get_date_from_form
+ ('enddate_'.$plot_num);
+ ($starttime,$endtime) = &ensure_start_end_times
+ ($starttime,$endtime,
+ &get_time_from_row($response_data->[0]),
+ &get_time_from_row($response_data->[-1]),
+ $plot_num);
+ $pre_graph_text =
+ 'Data from [_6] to [_7]
[_2] submissions from [_5] students, [_3] correct, [_4] incorrect';
+ $extra_data[0] = &Apache::lonlocal::locallocaltime($starttime);
+ $extra_data[1] = &Apache::lonlocal::locallocaltime($endtime);
+ #
+ $post_graph_text =
+ &mt('Start time: [_1]',
+ &Apache::lonhtmlcommon::date_setter
+ ('Statistics','startdate_'.$plot_num,$starttime)).
+ '
'.
+ &mt('End time: [_1]',
+ &Apache::lonhtmlcommon::date_setter
+ ('Statistics','enddate_'.$plot_num,$endtime));
+ $restriction_function =
+ sub {
+ my $t = $_[0]->{'timestamp'};
+ if ($t >= $starttime && $t < $endtime) {
+ return 1;
+ } else {
+ return 0;
+ }
+ };
+ $no_data_text = 'No data for [_5] to [_6]';
+ }
+ my $foil_choice_data =
+ &classify_response_data($response_data,$correct,
+ $restriction_function);
+ # &Apache::lonstathelpers::log_hash_ref($foil_choice_data);
+ my $answers;
+ if (ref($correct)) {
+ my %tmp;
+ foreach my $foil (values(%$correct)) {
+ $tmp{$foil}++;
+ }
+ $answers = [keys(%tmp)];
+ } else {
+ $answers = [$correct];
+ }
+ # Concept Plot
+ my $concept_plot = '';
+ if (scalar(@$concepts) > 1) {
+ $concept_plot = &RR_concept_plot($concepts,$foil_choice_data,
+ 'Correct Concepts');
+ }
+ # % Choosing plot
+ my $choice_plot = &RR_create_percent_selected_plot
+ ($concepts,$foils,$foil_choice_data,$correct_foil_title);
+ # for each correct foil, how did they mark it? (stacked bar graph)
+ my ($stacked_plot,$count_by_foil);
+ if ($problem_analysis->{'answercomputed'} || $num_true > 1) {
+ ($stacked_plot,$count_by_foil) =
+ &RR_create_stacked_selection_plot($foils,$foil_choice_data,
+ $incorrect_foil_title,
+ \%true_foils);
+ }
+ #
+ if ($concept_plot ne '' ||
+ $choice_plot ne '' ||
+ $stacked_plot ne '') {
+ my $correct = $foil_choice_data->{'_correct'};
+ if (! defined($correct) || $correct eq '') {
+ $correct = 0;
+ }
+ my $incorrect =
+ $analysis_html.= ''.
+ ''.
+ &mt($pre_graph_text,
+ $plot_num,$foil_choice_data->{'_count'},
+ $correct,
+ $foil_choice_data->{'_count'}-$correct,
+ $foil_choice_data->{'_students'},
+ @extra_data).
+ ' |
'.$/;
+ $analysis_html.=
+ ''.
+ ''.$concept_plot.' | '.
+ ''.$choice_plot.' | ';
+ if ($stacked_plot ne '') {
+ $analysis_html .=
+ ''.$stacked_plot.' | '.
+ ''.&build_foil_key($foils,$count_by_foil).' | ';
+ } else {
+ $analysis_html .= (' | 'x2);
+ }
+ $analysis_html.='
'.$/;
+ if (defined($post_graph_text)) {
+ $analysis_html.= ''.
+ $post_graph_text.' |
'.$/;
+ }
+ } elsif ($no_data_text ne '') {
+ $analysis_html.=''.
+ &mt($no_data_text,
+ $plot_num,$foil_choice_data->{'_count'},
+ $correct,
+ $foil_choice_data->{'_count'}-$correct,
+ @extra_data);
+ if (defined($post_graph_text)) {
+ $analysis_html.=' '.$post_graph_text;
+ }
+ $analysis_html.=' |
'.$/;
+ }
+ } # end of loop for plots
+ $analysis_html.='
';
+ $r->print($analysis_html);
+}
- my $interval = 1;
- for(my $n=1; $n<=7; $n++) {
- if($selectedInterval == $n) {
- $interval = $n;
+sub ensure_start_end_times {
+ my ($start,$end,$first,$last,$plot_num) = @_;
+ if (! defined($start) || ! defined($end)) {
+ my $sec_in_day = 86400;
+ my ($sday,$smon,$syear) =
+ (localtime($last - $sec_in_day*($plot_num-1)))[3..5];
+ $start = &Time::Local::timelocal(0,0,0,$sday,$smon,$syear);
+ $end = $start + $sec_in_day;
+ if ($plot_num == $ENV{'form.NumPlots'}) {
+ $start = $first;
}
}
+ return ($start,$end);
+}
- my $Ptr = '
Select number of intervals'."\n".
- ''."\n";
+ #
+ # need arrays for incorrect and correct because we want to use different
+ # colors for them
+ my @correct;
+ #
+ my $total =0;
+ for (my $i=0;$i[$i];
+ $correct[$i] = $correct_by_concept{$concept->{'name'}};
+ $total += $correct_by_concept{$concept->{'name'}}+
+ $incorrect_by_concept{$concept->{'name'}};
+ }
+ if ($total == 0) { return ''; };
+ for (my $i=0;$i<=$#correct;$i++) {
+ $correct[$i] = sprintf('%0f',$correct[$i]/$total*100);
+ }
+ my $xlabel = 'concept';
+ my $plot= &Apache::loncommon::DrawBarGraph($title,
+ $xlabel,
+ 'Percent Choosing',
+ 100,
+ ['#33ff00','#ff3300'],
+ undef,
+ \@correct);
+ return $plot;
+}
- return $Ptr;
+sub RR_create_percent_selected_plot {
+ my ($concepts,$foils,$foil_data,$title) = @_;
+ #
+ if ($foil_data->{'_count'} == 0) { return ''; };
+ my %correct_selections;
+ my %incorrect_selections;
+ foreach my $foil (@$foils) {
+ # foil_data has format $foil_data->{true_foil}->{selected foil}=count
+ next if (! exists($foil_data->{$foil}));
+ while (my ($f,$count)= each(%{$foil_data->{$foil}})) {
+ if ($f eq $foil) {
+ $correct_selections{$foil} += $count;
+ } else {
+ $incorrect_selections{$f} += $count;
+ }
+ }
+ }
+ #
+ # need arrays for incorrect and correct because we want to use different
+ # colors for them
+ my @correct;
+ my @incorrect;
+ #
+ my $total = $foil_data->{'_count'};
+ for (my $i=0;$i[$i];
+ $correct[$i] = $correct_selections{$foil};
+ $incorrect[$i] = $incorrect_selections{$foil};
+ }
+ for (my $i=0;$i<=$#correct;$i++) {
+ $correct[$i] = sprintf('%2f',$correct[$i]/$total*100);
+ }
+ for (my $i=0;$i<=$#incorrect;$i++) {
+ $incorrect[$i] = sprintf('%2f',$incorrect[$i]/$total*100);
+ }
+ #
+ # Put a blank in the data sets between concepts, if there are concepts
+ my @labels;
+ if (defined($concepts) && scalar(@$concepts) > 1) {
+ my @new_correct;
+ my @new_incorrect;
+ my $foil_count = 0;
+ foreach my $concept (@$concepts) {
+ foreach (@{$concept->{'foils'}}) {
+ push(@new_correct, $correct[$foil_count]);
+ push(@new_incorrect,$incorrect[$foil_count]);
+ push(@labels,++$foil_count);
+ }
+ push(@new_correct,'');
+ push(@new_incorrect,'');
+ push(@labels,'');
+ }
+ @correct = @new_correct;
+ @incorrect = @new_incorrect;
+ } else {
+ @labels = (1 .. scalar(@correct));
+ }
+ #
+ my $xlabel = 'foil chosen';
+ my $plot= &Apache::loncommon::DrawBarGraph($title,
+ $xlabel,
+ 'Percent Choosing',
+ 100,
+ ['#33ff00','#ff3300'],
+ \@labels,
+ \@correct,
+ \@incorrect);
+ return $plot;
}
-sub OptionResponseTable {
- my ($optionResponses)=@_;
- my $Str = '';
- $Str .= '
Option Response Problems in this course:'."\n";
- $Str .= '
'."\n";
- $Str .= " \# | Problem Title | ";
- $Str .= ' Resource | Analysis |
'."\n";
-
- my $number=1;
- foreach (split(':::', $optionResponses)) {
- my ($uri,$title,$part,$problem)=split('::',$_);
- my $Temp = ''.$title.'';
- $Str .= '';
- $Str .= ' '.$number.' | ';
- $Str .= ' '.$Temp.' | ';
- $Str .= ' '.$uri.' | ';
- $Str .= ' |
'."\n";
- $number++;
+sub RR_create_stacked_selection_plot {
+ my ($foils,$foil_data,$title,$true_foils)=@_;
+ #
+ my @dataset; # array of array refs - multicolor rows $datasets[row]->[col]
+ my @labels;
+ my $count;
+ my %column; # maps foil name to column in @datasets
+ for (my $i=0;$i[$i];
+ if (defined($true_foils) && scalar(keys(%$true_foils)) > 0 ) {
+ next if (! $true_foils->{$foil} );
+ push(@labels,$i+1);
+ } else {
+ next if (! exists($foil_data->{$foil}));
+ push(@labels,$i+1);
+ }
+ next if (! exists($foil_data->{$foils->[$i]}));
+ $column{$foil}= $count++;
+ for (my $j=0;$j{$foil}->{$foils->[$j]};
+ }
+ $dataset[$j]->[$column{$foil}]=$value;
+ }
}
- $Str .= '
'."\n";
+ #
+ return '' if (! scalar(keys(%column)));
+ #
+ my $grand_total = 0;
+ my %count_per_foil;
+ while (my ($foil,$bar) = each (%column)) {
+ my $bar_total = 0;
+ for (my $j=0;$j[$bar];
+ }
+ next if ($bar_total == 0);
+ for (my $j=0;$j[$bar] =
+ sprintf('%2f',$dataset[$j]->[$bar]/$bar_total * 100);
+ }
+ $count_per_foil{$foil}=' ( '.$bar_total.' )';
+ $grand_total += $bar_total;
+ }
+ if ($grand_total == 0) {
+ return ('',undef);
+ }
+ my @empty_row = ();
+ foreach (@{$dataset[0]}) {
+ push(@empty_row,0);
+ }
+ #
+ my $graph = &Apache::loncommon::DrawBarGraph
+ ($title,'Correct Foil','foils chosen Incorrectly',
+ 100,$plotcolors,\@labels,\@empty_row,@dataset);
+ return ($graph,\%count_per_foil);
+}
- return $Str;
+
+#########################################################
+#########################################################
+##
+## Misc routines
+##
+#########################################################
+#########################################################
+
+# if $correct is a hash ref, it is assumed to be indexed by student names.
+# the values are assumed to be hash refs with a key of 'answer'.
+sub classify_response_data {
+ my ($full_row_data,$correct,$function) = @_;
+ my %submission_data;
+ my %students;
+ my $max=0;
+ foreach my $row (@$full_row_data) {
+ my %subm = &hashify_attempt($row);
+ if (ref($correct) eq 'HASH') {
+ $subm{'correct'} = $correct->{$subm{'student'}};
+ } else {
+ $subm{'correct'} = $correct;
+ }
+ $subm{'submission'} =~ s/=\d+\s*$//;
+ if (&$function(\%subm)) {
+ $students{$subm{'student'}}++;
+ $submission_data{'_count'}++;
+ if (&submission_is_correct($subm{'award'})) {
+ $submission_data{'_correct'}++;
+ }
+
+ if($max<++$submission_data{$subm{'correct'}}->{$subm{'submission'}}) {
+ $max=$submission_data{$subm{'correct'}}->{$subm{'submission'}};
+ }
+ }
+ }
+ $submission_data{'_max'} = $max;
+ $submission_data{'_students'}=scalar(keys(%students));
+ return \%submission_data;
+}
+
+
+#########################################################
+#########################################################
+##
+## Option Response Routines
+##
+#########################################################
+#########################################################
+sub OptionResponseAnalysis {
+ my ($r,$problem,$problem_data,$Students) = @_;
+ my ($resource,$respid) = ($problem->{'resource'},
+ $problem->{'respid'});
+ # Note: part data is not needed.
+ my $PerformanceData = &Apache::loncoursedata::get_response_data
+ (\@Apache::lonstatistics::SelectedSections,
+ $Apache::lonstatistics::enrollment_status,
+ $resource->{'symb'},$respid);
+ if (! defined($PerformanceData) ||
+ ref($PerformanceData) ne 'ARRAY' ) {
+ $r->print(''.
+ &mt('There is no student data for this problem.').
+ '
');
+ } else {
+ $r->rflush();
+ if (exists($ENV{'form.ExcelOutput'})) {
+ my $result = &OR_excel_sheet($r,$resource,
+ $PerformanceData,
+ $problem_data);
+ $r->print($result);
+ $r->rflush();
+ } else {
+ if ($ENV{'form.AnalyzeOver'} eq 'tries') {
+ my $analysis_html = &OR_tries_analysis($r,
+ $PerformanceData,
+ $problem_data);
+ $r->print($analysis_html);
+ $r->rflush();
+ } elsif ($ENV{'form.AnalyzeOver'} eq 'time') {
+ my $analysis_html = &OR_time_analysis($PerformanceData,
+ $problem_data);
+ $r->print($analysis_html);
+ $r->rflush();
+ } else {
+ $r->print(''.
+ &mt('The analysis you have selected is '.
+ 'not supported at this time').
+ '
');
+ }
+ }
+ }
}
-#---- END Problem Analysis Web Page ------------------------------------------
+#########################################################
+#
+# Option Response: tries Analysis
+#
+#########################################################
+sub OR_tries_analysis {
+ my ($r,$PerformanceData,$ORdata) = @_;
+ my $mintries = 1;
+ my $maxtries = $ENV{'form.NumPlots'};
+ my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
+ if (! defined($Concepts)) {
+ $Concepts = [];
+ }
+ my %response_data = &OR_analyze_by_tries($r,$PerformanceData,
+ $mintries,$maxtries);
+ my $analysis = '';
+ #
+ # Compute the data necessary to make the plots
+ my @foil_plot;
+ my @concept_data;
+ for (my $j=0;$j<=scalar(@$Concepts);$j++) {
+ my $concept = $Concepts->[$j];
+ foreach my $foilid (@{$concept->{'foils'}}) {
+ for (my $try=$mintries;$try<=$maxtries;$try++) {
+ # concept analysis data
+ $concept_data[$j]->[$try]->{'_correct'} +=
+ $response_data{$foilid}->[$try]->{'_correct'};
+ $concept_data[$j]->[$try]->{'_total'} +=
+ $response_data{$foilid}->[$try]->{'_total'};
+ #
+ # foil analysis data
+ if ($response_data{$foilid}->[$try]->{'_total'} == 0) {
+ push(@{$foil_plot[$try]->{'_correct'}},0);
+ } else {
+ push(@{$foil_plot[$try]->{'_correct'}},
+ 100*$response_data{$foilid}->[$try]->{'_correct'}/
+ $response_data{$foilid}->[$try]->{'_total'});
+ }
+ foreach my $option (@{$ORdata->{'_Options'}}) {
+ push(@{$foil_plot[$try]->{'_total'}},
+ $response_data{$foilid}->[$try]->{'_total'});
+ if ($response_data{$foilid}->[$try]->{'_total'} == 0) {
+ push (@{$foil_plot[$try]->{$option}},0);
+ } else {
+ if ($response_data{$foilid}->[$try]->{'_total'} ==
+ $response_data{$foilid}->[$try]->{'_correct'}) {
+ push(@{$foil_plot[$try]->{$option}},0);
+ } else {
+ push (@{$foil_plot[$try]->{$option}},
+ 100 *
+ $response_data{$foilid}->[$try]->{$option} /
+ ($response_data{$foilid}->[$try]->{'_total'}
+ -
+ $response_data{$foilid}->[$try]->{'_correct'}
+ ));
+ }
+ }
+ } # End of foreach my $option
+ }
+ } # End of foreach my $foilid
+ } # End of concept loops
+ #
+ # Build a table for the plots
+ my $analysis_html = "
\n";
+ my $optionkey = &build_option_index($ORdata);
+ my $num_concepts = 1;
+ if (defined($Concepts)) { $num_concepts = scalar(@$Concepts); }
+ #
+ for (my $try=$mintries;$try<=$maxtries;$try++) {
+ if (! defined($response_data{'_total'}->[$try]) ||
+ $response_data{'_total'}->[$try] == 0) {
+ if ($try > 1) {
+ $analysis_html.= ''.
+ &mt('None of the selected students attempted the problem more than [_1] times.',$try-1).
+ ' |
';
+ } else {
+ $analysis_html.= ''.
+ &mt('None of the selected students have attempted the problem').' |
';
+ }
+ last;
+ }
+ my $concept_graph='';
+ if ($num_concepts > 1) {
+ #
+ # Create concept plot
+ my @concept_plot_data;
+ for (my $j=0;$j<=$#concept_data;$j++) {
+ my $total = $concept_data[$j]->[$try]->{'_total'};
+ if ($total == 0) {
+ $concept_plot_data[$j] = 0;
+ } else {
+ $concept_plot_data[$j] = 100 *
+ sprintf('%0.3f',
+ $concept_data[$j]->[$try]->{'_correct'} /
+ $total);
+ }
+ }
+ #
+ $concept_graph = &Apache::loncommon::DrawBarGraph
+ ('Correct Concepts','Concept Number','Percent Correct',
+ 100,$plotcolors,undef,\@concept_plot_data,{xskip=>1});
+ }
+ #
+ # Create Foil Plots
+ my $data_count = $response_data{'_total'}->[$try];
+ my $correct = $response_data{'_correct'}->[$try];
+ my @Datasets;
+ foreach my $option ('_correct',@{$ORdata->{'_Options'}}) {
+ next if (! exists($foil_plot[$try]->{$option}));
+ push(@Datasets,$foil_plot[$try]->{$option});
+ }
+ #
+ # Put a blank in the data set between concepts
+ for (my $set =0;$set<=$#Datasets;$set++) {
+ my @Data = @{$Datasets[$set]};
+ my $idx = 0;
+ foreach my $concept (@{$Concepts}) {
+ foreach my $foilid (@{$concept->{'foils'}}) {
+ $Datasets[$set]->[$idx++]=shift(@Data);
+ }
+ if ($concept->{'name'} ne $Concepts->[-1]->{'name'}) {
+ $Datasets[$set]->[$idx++] = 0;
+ }
+ }
+ }
+ #
+ # Set up the labels needed for the bar graph
+ my @Labels;
+ my $idx = 1;
+ foreach my $concept (@{$Concepts}) {
+ foreach my $foilid (@{$concept->{'foils'}}) {
+ push(@Labels,$idx++);
+ }
+ push(@Labels,'');
+ }
+ #
+ my $correct_graph = &Apache::loncommon::DrawBarGraph
+ ('Correct Statements','Statement','% Answered Correct',
+ 100,$plotcolors,\@Labels,$Datasets[0],{xskip=>1});
+
+ #
+ #
+ next if (! defined($Datasets[0]));
+ for (my $i=0; $i< scalar(@{$Datasets[0]});$i++) {
+ $Datasets[0]->[$i]=0;
+ }
+ my $count = $response_data{'_total'}->[$try] -
+ $response_data{'_correct'}->[$try];
+ my $incorrect_graph = &Apache::loncommon::DrawBarGraph
+ ('Incorrect Statements','Statement','% Chosen Incorrectly',
+ 100,$plotcolors,\@Labels,@Datasets,{xskip=>1});
+ $analysis_html.=
+ ''.
+ ''.
+ &mt('Attempt [_1], [_2] submissions, [_3] correct, [_4] incorrect',
+ $try,$data_count,$correct,$data_count-$correct).
+ ''.' |
'.$/.
+ ''.
+ ''.$concept_graph.' | '.
+ ''.$correct_graph.' | '.
+ ''.$incorrect_graph.' | '.
+ ''.$optionkey.' | '.
+ ' |
'.$/;
+ }
+ $analysis_html .= "
\n";
+ $table .= $analysis_html;
+ return $table;
+}
-#---- Analyze Web Page -------------------------------------------------------
+sub OR_analyze_by_tries {
+ my ($r,$PerformanceData,$mintries,$maxtries) = @_;
+ my %Trydata;
+ $mintries = 1 if (! defined($mintries) || $mintries < 1);
+ $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
+ my @students;
+ foreach my $row (@$PerformanceData) {
+ next if (! defined($row));
+ my $tries = &get_tries_from_row($row);
+ my %Row = &Process_OR_Row($row);
+ next if (! %Row);
+ my $student_id = $row->[&Apache::loncoursedata::RD_student_id()];
+ $students[$tries]->{$student_id}++;
+ while (my ($foilid,$href) = each(%Row)) {
+ if (! ref($href)) {
+ $Trydata{$foilid}->[$tries] += $href;
+ next;
+ }
+ while (my ($option,$value) = each(%$href)) {
+ $Trydata{$foilid}->[$tries]->{$option}+=$value;
+ }
+ }
+ }
+ for (my $try=$mintries;$try<=$maxtries;$try++) {
+ $Trydata{'_studentcount'}->[$try] = scalar(keys(%{$students[$try]}));
+ }
+ return %Trydata;
+}
-#restore the student submissions and finding the result
-sub OpStatus {
- my ($problem, $student, $courseID, $ConceptData, $foil_to_concept,
- $Answer)=@_;
- my ($username,$userdomain)=split(/':'/,$student);
- my $code='U';
- my %reshash=&Apache::lonnet::restore($problem, $courseID, $userdomain,
- $username);
- my @True = ();
- my @False = ();
- my $flag=0;
- if ($reshash{'version'}) {
- my $tries=0;
- &Apache::lonhomework::showhash(%$Answer);
- for (my $version=1;$version<=$reshash{'version'};$version++) {
- my $time=$reshash{"$version:timestamp"};
-
- foreach my $key (sort(split(/\:/,$reshash{$version.':keys'}))) {
- if (($key=~/\.(\w+)\.(\w+)\.submission$/)) {
- my $Id1 = $1; my $Id2 = $2;
- #check if this is a repeat submission, if so skip it
- if ($reshash{"$version:resource.$Id1.previous"}) { next; }
- #if no solved this wasn't a real submission, ignore it
- if (!defined($reshash{"$version:resource.$Id1.solved"})) {
- &Apache::lonxml::debug("skipping ");
- next;
- }
- my $Resp = $reshash{"$version:$key"};
- my %submission=&Apache::lonnet::str2hash($Resp);
- foreach (keys %submission) {
- my $Ansr = $Answer->{"$Id1.$Id2.foil.value.$_"};
- if ($submission{$_}) {
- if ($submission{$_} eq $Ansr) {
- &Decide("true", $foil_to_concept->{$_},
- $time, $ConceptData);
- } else {
- &Decide("false", $foil_to_concept->{$_},
- $time, $ConceptData);}
- }
- }
- }
- }
- }
- }
-}
-
-sub DrawGraph {
- my ($k,$Src,$Concepts,$ConceptData)=@_;
- my $Max=0;
- my @data1;
- my @data2;
-
- # Adjust Data and find the Max
- for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
- my $tmp=$Concepts->[$n];
- $data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
- $data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
- my $Sum=$data1[$n]+$data2[$n];
- if($Max < $Sum) {
- $Max=$Sum;
- }
- }
- for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
- if ($data1[$n]+$data2[$n]<$Max) {
- $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
- }
- }
- my $P_No = (scalar @data1);
-
- if($Max > 1) {
- $Max += (10 - $Max % 10);
- $Max = int($Max);
+#########################################################
+#
+# Option Response: Time Analysis
+#
+#########################################################
+sub OR_time_analysis {
+ my ($performance_data,$ORdata) = @_;
+ my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
+ my $foilkey = &build_option_index($ORdata);
+ my $num_concepts = 1;
+ if (defined($Concepts)) { $num_concepts = scalar(@$Concepts); }
+ #
+ if ($num_concepts < 2) {
+ $table = ''.
+ &mt('Not enough data for concept analysis. '.
+ 'Performing Foil Analysis').
+ '
'.$table;
+ }
+ #
+ my $num_plots = $ENV{'form.NumPlots'};
+ my $num_data = scalar(@$performance_data)-1;
+ #
+ my $current_index;
+ $table .= "\n";
+ for (my $i=0;$i<$num_plots;$i++) {
+ ##
+ my $starttime = &Apache::lonhtmlcommon::get_date_from_form
+ ('startdate_'.$i);
+ my $endtime = &Apache::lonhtmlcommon::get_date_from_form
+ ('enddate_'.$i);
+ if (! defined($starttime) || ! defined($endtime)) {
+ my $sec_in_day = 86400;
+ my $last_sub_time = &get_time_from_row($performance_data->[-1]);
+ my ($sday,$smon,$syear) =
+ (localtime($last_sub_time - $sec_in_day*$i))[3..5];
+ $starttime = &Time::Local::timelocal(0,0,0,$sday,$smon,$syear);
+ $endtime = $starttime + $sec_in_day;
+ if ($i == ($num_plots -1 )) {
+ $starttime = &get_time_from_row($performance_data->[0]);
+ }
+ }
+ $table .= ''.
+ &mt('Data from [_1] to [_2]',
+ &Apache::lonlocal::locallocaltime($starttime),
+ &Apache::lonlocal::locallocaltime($endtime)).
+ ' |
'.$/;
+ my $startdateform = &Apache::lonhtmlcommon::date_setter
+ ('Statistics','startdate_'.$i,$starttime);
+ my $enddateform = &Apache::lonhtmlcommon::date_setter
+ ('Statistics','enddate_'.$i,$endtime);
+ #
+ my $begin_index;
+ my $end_index;
+ my $j;
+ while (++$j < scalar(@$performance_data)) {
+ last if (&get_time_from_row($performance_data->[$j])
+ > $starttime);
+ }
+ $begin_index = $j;
+ while ($j < scalar(@$performance_data)) {
+ if (&get_time_from_row($performance_data->[$j]) > $endtime) {
+ last;
+ } else {
+ $j++;
+ }
+ }
+ $end_index = $j;
+ ##
+ my ($processed_time_data,$correct,$data_count,$student_count) =
+ &OR_time_process_data($performance_data,$begin_index,$end_index);
+ ##
+ $table .= ''.
+ &mt('[_1] submissions from [_2] students, [_3] correct, [_4] incorrect',
+ $data_count,$student_count,$correct,$data_count-$correct).
+ ' |
'.$/;
+ my $concept_correct_plot = '';
+ if ($num_concepts > 1) {
+ $concept_correct_plot =
+ &OR_Concept_Time_Analysis($processed_time_data,
+ $correct,$data_count,$student_count,
+ $ORdata,$Concepts);
+ }
+ my ($foil_correct_plot,$foil_incorrect_plot) =
+ &OR_Foil_Time_Analysis($processed_time_data,
+ $correct,$data_count,$student_count,
+ $ORdata,$Foils,$Concepts);
+ $table .= ''.
+ ''.$concept_correct_plot.' | '.
+ ''.$foil_correct_plot.' | '.
+ ''.$foil_incorrect_plot.' | '.
+ ''.$foilkey.' |
'.$/;
+ $table .= ''.
+ &mt('Start time: [_1]',$startdateform).' '.
+ &mt('End time: [_1]',$enddateform).' |
'.$/;
+ $table.= '  |
'.$/;
+ }
+ $table .= '
';
+ #
+ return $table;
+}
+
+sub OR_Foil_Time_Analysis {
+ my ($processed_time_data,$correct,$data_count,$student_count,
+ $ORdata,$Foils,$Concepts) = @_;
+ if ($data_count <= 0) {
+ return (''.&mt('There is no data to plot').'
','');
+ }
+ my $analysis_html;
+ my @plotdata;
+ my @labels;
+ foreach my $concept (@{$Concepts}) {
+ foreach my $foil (@{$concept->{'foils'}}) {
+ push(@labels,scalar(@labels)+1);
+ my $total = $processed_time_data->{$foil}->{'_total'};
+ if ($total == 0) {
+ push(@{$plotdata[0]},0);
+ } else {
+ push(@{$plotdata[0]},
+ 100 * $processed_time_data->{$foil}->{'_correct'} / $total);
+ }
+ my $total_incorrect = $total - $processed_time_data->{$foil}->{'_correct'};
+ for (my $i=0;$i{'_Options'}});$i++) {
+ my $option = $ORdata->{'_Options'}->[$i];
+ if ($total_incorrect == 0) {
+ push(@{$plotdata[$i+1]},0);
+ } else {
+ push(@{$plotdata[$i+1]},
+ 100 * $processed_time_data->{$foil}->{$option} / $total_incorrect);
+ }
+ }
+ }
+ # Put in a blank one
+ push(@labels,'');
+ push(@{$plotdata[0]},0);
+ for (my $i=0;$i{'_Options'}});$i++) {
+ push(@{$plotdata[$i+1]},0);
+ }
+ }
+ #
+ # Create the plot
+ my $correct_plot = &Apache::loncommon::DrawBarGraph('Correct Statements',
+ 'Statement Number',
+ 'Percent Correct',
+ 100,
+ $plotcolors,
+ undef,
+ $plotdata[0],
+ {xskip=>1});
+ for (my $j=0; $j< scalar(@{$plotdata[0]});$j++) {
+ $plotdata[0]->[$j]=0;
+ }
+ my $incorrect_plot =
+ &Apache::loncommon::DrawBarGraph('Incorrect Statements',
+ 'Statement Number',
+ 'Incorrect Option Choice',
+ 100,
+ $plotcolors,
+ undef,
+ @plotdata,{xskip=>1});
+ return ($correct_plot,$incorrect_plot);
+}
+
+sub OR_Concept_Time_Analysis {
+ my ($processed_time_data,$correct,$data_count,$student_count,
+ $ORdata,$Concepts) = @_;
+ return '' if ($data_count == 0);
+ #
+ # Put the data in plottable form
+ my @plotdata;
+ foreach my $concept (@$Concepts) {
+ my ($total,$correct);
+ foreach my $foil (@{$concept->{'foils'}}) {
+ $total += $processed_time_data->{$foil}->{'_total'};
+ $correct += $processed_time_data->{$foil}->{'_correct'};
+ }
+ if ($total == 0) {
+ push(@plotdata,0);
+ } else {
+ push(@plotdata,100 * $correct / $total);
+ }
+ }
+ #
+ # Create the plot
+ return &Apache::loncommon::DrawBarGraph('Correct Concepts',
+ 'Concept Number',
+ 'Percent Correct',
+ 100,
+ $plotcolors,
+ undef,
+ \@plotdata,{xskip=>1});
+}
+
+sub OR_time_process_data {
+ my ($performance_data,$begin_index,$end_index)=@_;
+ my %processed_time_data;
+ my %distinct_students;
+ my ($correct,$data_count);
+ if (($begin_index == $end_index) &&
+ ($end_index != scalar(@$performance_data)-1)) {
+ return undef;
+ }
+ # Be sure we include the last one if we are asked for it.
+ # That we have to correct here (and not when $end_index is
+ # given a value) should probably be considered a bug.
+ if ($end_index == scalar(@$performance_data)-1) {
+ $end_index++;
+ }
+ my $count;
+ for (my $i=$begin_index;$i<$end_index;$i++) {
+ my $attempt = $performance_data->[$i];
+ $count++;
+ next if (! defined($attempt));
+ my %attempt = &Process_OR_Row($attempt);
+ $data_count++;
+ $correct += $attempt{'_correct'};
+ $distinct_students{$attempt->[&Apache::loncoursedata::RD_student_id()]}++;
+ while (my ($foilid,$href) = each(%attempt)) {
+ if (! ref($href)) {
+ $processed_time_data{$foilid} += $href;
+ next;
+ }
+ while (my ($option,$value) = each(%$href)) {
+ $processed_time_data{$foilid}->{$option}+=$value;
+ }
+ }
+ }
+ return (\%processed_time_data,$correct,$data_count,
+ scalar(keys(%distinct_students)));
+}
+
+#########################################################
+#########################################################
+##
+## Excel output
+##
+#########################################################
+#########################################################
+sub build_student_data_worksheet {
+ my ($workbook,$format) = @_;
+ my $rows_output = 3;
+ my $cols_output = 0;
+ my $worksheet = $workbook->addworksheet('Student Data');
+ $worksheet->write($rows_output++,0,'Student Data',$format->{'h3'});
+ my @Headers = ('full name','username','domain','section',
+ "student\nnumber",'identifier');
+ $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
+ my @Students = @Apache::lonstatistics::Students;
+ my $studentrows = &Apache::loncoursedata::get_student_data(\@Students);
+ my %ids;
+ foreach my $row (@$studentrows) {
+ my ($mysqlid,$student) = @$row;
+ $ids{$student}=$mysqlid;
+ }
+ foreach my $student (@Students) {
+ my $name_domain = $student->{'username'}.':'.$student->{'domain'};
+ $worksheet->write_row($rows_output++,0,
+ [$student->{'fullname'},
+ $student->{'username'},$student->{'domain'},
+ $student->{'section'},$student->{'id'},
+ $ids{$name_domain}]);
+ }
+ return $worksheet;
+}
+
+sub OR_excel_sheet {
+ my ($r,$resource,$performance_data,$ORdata) = @_;
+ my $response = '';
+ my (undef,$Foils,$Concepts) = &build_foil_index($ORdata);
+ #
+ # Create excel worksheet
+ my $filename = '/prtspool/'.
+ $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
+ time.'_'.rand(1000000000).'.xls';
+ my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
+ if (! defined($workbook)) {
+ $r->log_error("Error creating excel spreadsheet $filename: $!");
+ $r->print(''.&mt("Unable to create new Excel file. ".
+ "This error has been logged. ".
+ "Please alert your LON-CAPA administrator").
+ '
');
+ return undef;
+ }
+ #
+ $workbook->set_tempdir('/home/httpd/perl/tmp');
+ my $format = &Apache::loncommon::define_excel_formats($workbook);
+ #
+ # Create and populate main worksheets
+ my $problem_data_sheet = $workbook->addworksheet('Problem Data');
+ my $student_data_sheet = &build_student_data_worksheet($workbook,$format);
+ my $response_data_sheet = $workbook->addworksheet('Response Data');
+ foreach my $sheet ($problem_data_sheet,$student_data_sheet,
+ $response_data_sheet) {
+ $sheet->write(0,0,$resource->{'title'},$format->{'h2'});
+ $sheet->write(1,0,$resource->{'src'},$format->{'h3'});
+ }
+ #
+ my $result;
+ $result = &OR_build_problem_data_worksheet($problem_data_sheet,$format,
+ $Concepts,$ORdata);
+ if ($result ne 'okay') {
+ # Do something useful
+ }
+ $result = &OR_build_response_data_worksheet($response_data_sheet,$format,
+ $performance_data,$Foils,
+ $ORdata);
+ if ($result ne 'okay') {
+ # Do something useful
+ }
+ $response_data_sheet->activate();
+ #
+ # Close the excel file
+ $workbook->close();
+ #
+ # Write a link to allow them to download it
+ $result .= ''.&mt('Excel Raw Data Output').'
'.
+ ''.
+ &mt('Your Excel spreadsheet.').
+ '
'."\n";
+ return $result;
+}
+
+sub OR_build_problem_data_worksheet {
+ my ($worksheet,$format,$Concepts,$ORdata) = @_;
+ my $rows_output = 3;
+ my $cols_output = 0;
+ $worksheet->write($rows_output++,0,'Problem Structure',$format->{'h3'});
+ ##
+ ##
+ my @Headers;
+ if (@$Concepts > 1) {
+ @Headers = ("Concept\nNumber",'Concept',"Foil\nNumber",
+ 'Foil Name','Foil Text','Correct value');
} else {
- $Max = 1;
+ @Headers = ('Foil Number','FoilName','Foil Text','Correct value');
+ }
+ $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
+ my %Foildata = %{$ORdata->{'_Foils'}};
+ my $conceptindex = 1;
+ my $foilindex = 1;
+ foreach my $concept (@$Concepts) {
+ my @FoilsInConcept = @{$concept->{'foils'}};
+ my $firstfoil = shift(@FoilsInConcept);
+ if (@$Concepts > 1) {
+ $worksheet->write_row($rows_output++,0,
+ [$conceptindex,
+ $concept->{'name'},
+ $foilindex++,
+ $Foildata{$firstfoil}->{'name'},
+ $Foildata{$firstfoil}->{'text'},
+ $Foildata{$firstfoil}->{'value'},]);
+ } else {
+ $worksheet->write_row($rows_output++,0,
+ [ $foilindex++,
+ $Foildata{$firstfoil}->{'name'},
+ $Foildata{$firstfoil}->{'text'},
+ $Foildata{$firstfoil}->{'value'},]);
+ }
+ foreach my $foilid (@FoilsInConcept) {
+ if (@$Concepts > 1) {
+ $worksheet->write_row($rows_output++,0,
+ ['',
+ '',
+ $foilindex,
+ $Foildata{$foilid}->{'name'},
+ $Foildata{$foilid}->{'text'},
+ $Foildata{$foilid}->{'value'},]);
+ } else {
+ $worksheet->write_row($rows_output++,0,
+ [$foilindex,
+ $Foildata{$foilid}->{'name'},
+ $Foildata{$foilid}->{'text'},
+ $Foildata{$foilid}->{'value'},]);
+ }
+ } continue {
+ $foilindex++;
+ }
+ } continue {
+ $conceptindex++;
+ }
+ $rows_output++;
+ $rows_output++;
+ ##
+ ## Option data output
+ $worksheet->write($rows_output++,0,'Options',$format->{'header'});
+ foreach my $string (@{$ORdata->{'_Options'}}) {
+ $worksheet->write($rows_output++,0,$string);
+ }
+ return 'okay';
+}
+
+sub OR_build_response_data_worksheet {
+ my ($worksheet,$format,$performance_data,$Foils,$ORdata)=@_;
+ my $rows_output = 3;
+ my $cols_output = 0;
+ $worksheet->write($rows_output++,0,'Response Data',$format->{'h3'});
+ $worksheet->set_column(1,1,20);
+ $worksheet->set_column(2,2,13);
+ my @Headers = ('identifier','time','award detail','attempt');
+ foreach my $foil (@$Foils) {
+ push (@Headers,$foil.' submission');
+ push (@Headers,$foil.' grading');
+ }
+ $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
+ #
+ foreach my $row (@$performance_data) {
+ next if (! defined($row));
+ my ($student,$award,$grading,$submission,$time,$tries) = @$row;
+ my @Foilgrades = split('&',$grading);
+ my @Foilsubs = split('&',$submission);
+ my %response_data;
+ for (my $j=0;$j<=$#Foilgrades;$j++) {
+ my ($foilid,$correct) = split('=',$Foilgrades[$j]);
+ my (undef,$submission) = split('=',$Foilsubs[$j]);
+ $submission = &Apache::lonnet::unescape($submission);
+ $foilid = &Apache::lonnet::unescape($foilid);
+ $response_data{$foilid.' submission'}=$submission;
+ $response_data{$foilid.' award'}=$correct;
+ }
+ $worksheet->write($rows_output,$cols_output++,$student);
+ $worksheet->write($rows_output,$cols_output++,
+ &Apache::lonstathelpers::calc_serial($time),$format->{'date'});
+ $worksheet->write($rows_output,$cols_output++,$award);
+ $worksheet->write($rows_output,$cols_output++,$tries);
+ foreach my $foilid (@$Foils) {
+ $worksheet->write($rows_output,$cols_output++,
+ $response_data{$foilid.' submission'});
+ $worksheet->write($rows_output,$cols_output++,
+ $response_data{$foilid.' award'});
+ }
+ $rows_output++;
+ $cols_output = 0;
+ }
+ return;
+}
+
+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 = lc($a);
+ my $b1 = lc($b);
+ if (exists($Numbers{$a1})) {
+ $a1 = $Numbers{$a1};
+ }
+ if (exists($Numbers{$b1})) {
+ $b1 = $Numbers{$b1};
+ }
+ if (($a1 =~/^\d+$/) && ($b1 =~/^\d+$/)) {
+ return $a1 <=> $b1;
+ } else {
+ return $a1 cmp $b1;
+ }
+ };
+ my @Concepts;
+ foreach my $concept (sort $sortfunction (keys(%Concepts))) {
+ if (! defined($Concepts{$concept})) {
+ $Concepts{$concept}=[];
+# next;
+ }
+ 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.' | '.
+ ''.&HTML::Entities::encode($concept->{'name'},'<>&"').' | '.
+ ''.$foilindex++.' | '.
+ ''.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').' | '.
+ ''.$Foildata{$firstfoil}->{'text'}.' | '.
+ ''.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').' | '.
+ "
\n";
+ } else {
+ $table .= ''.
+ ''.$foilindex++.' | '.
+ ''.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').' | '.
+ ''.$Foildata{$firstfoil}->{'text'}.' | '.
+ ''.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').' | '.
+ "
\n";
+ }
+ foreach my $foilid (@FoilsInConcept) {
+ if (@Concepts > 1) {
+ $table .= ''.
+ ' | '.
+ ' | '.
+ ''.$foilindex.' | '.
+ ''.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').' | '.
+ ''.$Foildata{$foilid}->{'text'}.' | '.
+ ''.&HTML::Entities::encode($Foildata{$foilid}->{'value'},'<>&"').' | '.
+ "
\n";
+ } else {
+ $table .= ''.
+ ''.$foilindex.' | '.
+ ''.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').' | '.
+ ''.$Foildata{$foilid}->{'text'}.' | '.
+ ''.&HTML::Entities::encode($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'}}) {
+ my $color = $plotcolors->[$optionindex++];
+ push (@Rows,
+ ''.
+ ''.
+ ''.('*'x3).''.' | '.
+ ''.&HTML::Entities::encode($option,'<>&"').' | '.
+ "
\n");
+ }
+ shift(@Rows); # Throw away 'correct option chosen' color
+ $table .= join('',reverse(@Rows));
+ $table .= "
\n";
+}
+
+sub build_foil_key {
+ my ($foils,$extra_data)= @_;
+ if (! defined($extra_data)) { $extra_data = {}; }
+ my $table = "\n";
+ my $foil_index = 0;
+ my @rows;
+ foreach my $foil (&mt('correct foil chosen'),@{$foils}) {
+ my $color = $plotcolors->[$foil_index++];
+ push (@rows,
+ ''.
+ ''.
+ ''.('*'x4).' | '.
+ ''.&HTML::Entities::encode($foil,'<>&"').
+ (' 'x2).$extra_data->{$foil}.' | '.
+ "
\n");
}
+ shift(@rows); # Throw away 'correct foil chosen' color
+ $table .= join('',reverse(@rows));
+ $table .= "
\n";
+}
- my $Titr=($ConceptData->{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
-# $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
- my $GData = '';
- $GData = $Titr.'&Concepts&Answers&'.$Max.'&'.$P_No.'&';
- $GData .= (join(',',@data1)).'&'.(join(',',@data2));
-
- return '';
-}
-
-sub DrawTable {
- my ($k,$Concepts,$ConceptData)=@_;
- my $Max=0;
- my @data1;
- my @data2;
- my $Correct=0;
- my $Wrong=0;
- for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
- my $tmp=$Concepts->[$n];
- $data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
- $Correct+=$data1[$n];
- $data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
- $Wrong+=$data2[$n];
- my $Sum=$data1[$n]+$data2[$n];
- if($Max < $Sum) {
- $Max=$Sum;
- }
- }
- for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
- if ($data1[$n]+$data2[$n]<$Max) {
- $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
- }
+#########################################################
+#########################################################
+##
+## Generic Interface Routines
+##
+#########################################################
+#########################################################
+sub CreateInterface {
+ ##
+ ## Environment variable initialization
+ if (! exists$ENV{'form.AnalyzeOver'}) {
+ $ENV{'form.AnalyzeOver'} = 'tries';
}
- my $P_No = (scalar @data1);
+ ##
+ ## Build the menu
my $Str = '';
-# $Str .= '
From: ['.localtime($ConceptData->{'Int.'.($k-1)});
-# $Str .= '] To: ['.localtime($ConceptData->{"Int.$k"}).']';
- $Str .= "\n".''.
- "\n".''.
- "\n".' # | '.
- "\n".' Concept | '.
- "\n".' Correct | '.
- "\n".' Wrong | '.
- "\n".'
';
-
- for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
- $Str .= ''."\n";
- $Str .= ''.($n+1).' | '."\n";
- $Str .= ''.$Concepts->[$n];
- $Str .= ' | '."\n";
- $Str .= ''.$data1[$n].' | '."\n";
- $Str .= ''.$data2[$n].' | '."\n";
- $Str .= '
'."\n";
- }
- $Str .= ' | From:['.localtime($ConceptData->{'Int.'.$k});
- $Str .= '] To: ['.localtime($ConceptData->{'Int.'.($k+1)}-1);
- $Str .= '] | '.$Correct.' | '.$Wrong.' | ';
+ $Str .= &Apache::lonhtmlcommon::breadcrumbs
+ (undef,'Detailed Problem Analysis');
+ $Str .= ''."\n";
+ $Str .= '';
+ $Str .= ''.&mt('Sections').' | ';
+ $Str .= ''.&mt('Enrollment Status').' | ';
+# $Str .= ''.&mt('Sequences and Folders').' | ';
+ $Str .= ' | ';
+ $Str .= '
'."\n";
+ ##
+ ##
+ $Str .= ''."\n";
+ $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
+ $Str .= ' | ';
+ #
+ $Str .= '';
+ $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
+ $Str .= ' | ';
+ #
+# $Str .= '';
+ my $only_seq_with_assessments = sub {
+ my $s=shift;
+ if ($s->{'num_assess'} < 1) {
+ return 0;
+ } else {
+ return 1;
+ }
+ };
+ &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
+ $only_seq_with_assessments);
+ ##
+ ##
+ $Str .= ' | ';
+ ##
+ my $showprob_checkbox =
+ '';
+ $Str.= ' ';
+ ##
+ my $analyze_selector = '';
+ $Str .= ' '.$/;
+ ##
+ my $numplots_selector = ' ';
+ $Str .= '';
+ ##
+ $Str .= '';
+ $Str .= ' | ';
+ ##
+ ##
+ $Str .= '
'."\n";
$Str .= '
'."\n";
-
return $Str;
-#$Apache::lonxml::debug=1;
-#&Apache::lonhomework::showhash(%ConceptData);
-#$Apache::lonxml::debug=0;
}
-#---- END Analyze Web Page ----------------------------------------------
-
-sub Decide {
- #deciding the true or false answer belongs to each interval
- my ($type,$concept,$time,$ConceptData)=@_;
- my $k=0;
- while ($time>$ConceptData->{'Int.'.($k+1)} &&
- $k<$ConceptData->{'Interval'}) {$k++;}
- $ConceptData->{$concept.'.'.$k.'.'.$type}++;
+#########################################################
+#########################################################
+##
+## Misc Option Response functions
+##
+#########################################################
+#########################################################
+sub get_time_from_row {
+ my ($row) = @_;
+ if (ref($row)) {
+ return $row->[&Apache::loncoursedata::RD_timestamp()];
+ }
+ return undef;
+}
- return;
+sub get_tries_from_row {
+ my ($row) = @_;
+ if (ref($row)) {
+ return $row->[&Apache::loncoursedata::RD_tries()];
+ }
+ return undef;
}
-sub InitAnalysis {
- my ($uri,$part,$problem,$student,$courseID)=@_;
- my ($name,$domain)=split(/\:/,$student);
-
- # Render the student's view of the problem. $Answ is the problem
- # Stringafied
- my $Answ=&Apache::lonnet::ssi($uri,('grade_target' => 'analyze',
- 'grade_username' => $name,
- 'grade_domain' => $domain,
- 'grade_courseid' => $courseID,
- 'grade_symb' => $problem));
-# my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze'));
-
-# (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
- my %Answer=();
- %Answer=&Apache::lonnet::str2hash($Answ);
-
- my $parts='';
- foreach my $elm (@{$Answer{'parts'}}) {
- $parts.= $elm.',';
- }
- $parts =~ s/,$//;
-
- my @Concepts=();
- foreach my $elm (@{$Answer{$parts.'.concepts'}}) {
- push(@Concepts, $elm);
+sub hashify_attempt {
+ my ($row) = @_;
+ my %attempt;
+ $attempt{'student'} = $row->[&Apache::loncoursedata::RD_sname()];
+ $attempt{'tries'} = $row->[&Apache::loncoursedata::RD_tries()];
+ $attempt{'submission'} = &Apache::lonnet::unescape($row->[&Apache::loncoursedata::RD_submission()]);
+ $attempt{'award'} = $row->[&Apache::loncoursedata::RD_awarddetail()];
+ $attempt{'timestamp'} = $row->[&Apache::loncoursedata::RD_timestamp()];
+ return %attempt;
+}
+
+sub Process_OR_Row {
+ my ($row) = @_;
+ my %RowData;
+# my $student_id = $row->[&Apache::loncoursedata::RD_student_id()];
+ my $award = $row->[&Apache::loncoursedata::RD_awarddetail()];
+ my $grading = $row->[&Apache::loncoursedata::RD_response_eval()];
+ my $submission = $row->[&Apache::loncoursedata::RD_submission()];
+ my $time = $row->[&Apache::loncoursedata::RD_timestamp()];
+# my $tries = $row->[&Apache::loncoursedata::RD_tries()];
+ return undef if ($award eq 'MISSING_ANSWER');
+ if (&submission_is_correct($award)) {
+ $RowData{'_correct'} = 1;
}
+ $RowData{'_total'} = 1;
+ my @Foilgrades = split('&',$grading);
+ my @Foilsubs = split('&',$submission);
+ for (my $j=0;$j<=$#Foilgrades;$j++) {
+ my ($foilid,$correct) = split('=',$Foilgrades[$j]);
+ $foilid = &Apache::lonnet::unescape($foilid);
+ my (undef,$submission) = split('=',$Foilsubs[$j]);
+ if ($correct) {
+ $RowData{$foilid}->{'_correct'}++;
+ } else {
+ $submission = &Apache::lonnet::unescape($submission);
+ $RowData{$foilid}->{$submission}++;
+ }
+ $RowData{$foilid}->{'_total'}++;
+ }
+ return %RowData;
+}
- my %foil_to_concept;
- foreach my $concept (@Concepts) {
- foreach my $foil (@{$Answer{$parts.'.concept.'.$concept}}) {
- $foil_to_concept{$foil} = $concept;
- #$ConceptData{$foil} = $Answer{$parts.'.foil.value.'.$foil};
- }
- }
-
- return (\@Concepts, \%foil_to_concept, \%Answer);
-}
-
-sub Interval {
- my ($part,$symb,$interval,$Concepts,$ConceptData)=@_;
- my $Int=$interval;
- my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb);
- my $opn = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb);
- my $add=int(($due-$opn)/$Int);
- $ConceptData->{'Int.0'}=$opn;
- for (my $i=1;$i<$Int;$i++) {
- $ConceptData->{'Int.'.$i}=$opn+$i*$add;
- }
- $ConceptData->{'Int.'.$Int}=$due;
- for (my $i=0;$i<$Int;$i++) {
- for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
- my $tmp=$Concepts->[$n];
- $ConceptData->{$tmp.'.'.$i.'.true'}=0;
- $ConceptData->{$tmp.'.'.$i.'.false'}=0;
- }
+sub submission_is_correct {
+ my ($award) = @_;
+ if ($award =~ /(APPROX_ANS|EXACT_ANS)/) {
+ return 1;
+ } else {
+ return 0;
}
}
+
1;
+
__END__