--- loncom/interface/statistics/lonproblemanalysis.pm 2002/11/25 18:12:52 1.15
+++ loncom/interface/statistics/lonproblemanalysis.pm 2005/02/23 02:03:42 1.115
@@ -1,7 +1,6 @@
# 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.115 2005/02/23 02:03:42 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,582 +24,1954 @@
#
# 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 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' });
sub BuildProblemAnalysisPage {
- my ($cacheDB, $r)=@_;
+ 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();
+ #
+ my $problem_types = '(option|radiobutton|numerical)';
+ 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(&Apache::lonstathelpers::submission_report_form
+ ('problem_analysis'));
+ #
+ $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;
- unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
- $r->print('Unable to tie database.');
+#########################################################
+#########################################################
+##
+## 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 $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);
-
+ 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,$stats) =
+ &numerical_classify_responses($response_data,$correct,
+ $restriction_function);
+ if ($stats->{'submission_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,
+ $stats->{'submission_count'},
+ $stats->{'correct_count'},
+ $stats->{'incorrect_count'},
+ $stats->{'students'},
+ @extra_data).
+ ' |
'.
+ ''.''.
+ &numerical_plot_percent($r,$responses,$stats).' | '.
+ ''.
+ &numerical_plot_differences($r,$responses,$stats).' | '.
+ '
';
+ }
+ if ($post_message ne '') {
+ $analysis_html .=
+ ''.$post_message.' |
';
+ }
+ }
+ $analysis_html.='
';
+ $r->print($analysis_html);
+ #
return;
}
-sub BuildAnalyzePage {
- my ($cacheDB, $students, $courseID,$r)=@_;
-
- $jr = $r;
- my $c = $r->connection;
-
- my $Str = '';
- my %cache;
-
- unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
- $Str .= 'Unable to tie database.';
- $r->print($Str);
- return;
+sub numerical_plot_percent {
+ my ($r,$responses,$stats) = @_;
+ #
+ my $total = $stats->{'submission_count'};
+ return '' if ($total == 0);
+ my $max_bins = 50;
+ my $lowest_percent = $stats->{'min_percent'};
+ my $highest_percent = $stats->{'max_percent'};
+ my $percent_spread = $highest_percent - $lowest_percent;
+ foreach (qw/20 30 40 50 100 200/) {
+ if ($percent_spread < $_) {
+ $highest_percent =$_/2;
+ last;
+ }
+ }
+ my $bin_size = 1;
+ foreach (qw/0.01 0.05 0.1 0.5 1 2 5 10 20 25 50 100/) {
+ if ($lowest_percent/2 < $_){
+ $bin_size = $_;
+ last;
+ }
}
+ my @bins;
+ for (my $bin = -$highest_percent;$bin<0;$bin+=$bin_size) {
+ push (@bins,$bin);
+ }
+ for (my $bin = 0; $bin<$highest_percent;$bin+=$bin_size) {
+ push (@bins,$bin);
+ }
+ push(@bins,$highest_percent);
+ #
+ my @correct;
+ my @incorrect;
+ my @count;
+ while (my ($ans,$submissions) = each(%$responses)) {
+ while (my ($submission,$counts) = each(%$submissions)) {
+ my ($correct_count,$incorrect_count) = @$counts;
+ my $scaled_value = 100*($submission-$ans)/abs($ans);
+ if ($scaled_value < $bins[0]) {
+ $bins[0]=$scaled_value -1;
+ }
+ my $bin;
+ for ($bin=0;$bin<$#bins;$bin++) {
+ last if ($bins[$bin]>$scaled_value);
+ }
+ $correct[$bin-1]+=$correct_count;
+ $incorrect[$bin-1]+=$incorrect_count;
+ $count[$bin-1]+=$correct_count+$incorrect_count;
+ }
+ }
+ #
+ my @plot_correct = @correct;
+ my @plot_incorrect = @incorrect;
+ my $max;
+ for (my $i=0;$i<$#bins;$i++) {
+ $plot_correct[$i] *= 100/$total;
+ $plot_incorrect[$i] *= 100/$total;
+ if (! defined($max) ||
+ $max < $plot_correct[$i]+$plot_incorrect[$i] ) {
+ $max = $plot_correct[$i]+$plot_incorrect[$i];
+ }
+ }
+ foreach (qw/1 5 10 15 20 25 30 40 50 75 100/) {
+ if ($max <$_) { $max = $_; last; }
+ }
+ #
+ my $title = &mt('Percent Difference');
+ my @labels = (1..scalar(@bins)-1);
+ my $graph = &Apache::loncommon::DrawBarGraph
+ ($title,'Percent Difference from Correct','Percent of Answers',
+ $max,['#33FF00','#FF3300'],\@labels,\@plot_correct,\@plot_incorrect,
+ {xskip=>1});
+ #
+ my $table = $graph.$/.
+ &numerical_bin_table(\@bins,\@labels,\@incorrect,\@correct,\@count).$/;
+ return $table;
+}
- # Remove students who don't have the proper section.
- my @sectionsSelected = split(':',$cache{'sectionsSelected'});
+sub numerical_plot_differences {
+ my ($r,$responses,$stats) = @_;
+ #
+ my $total = $stats->{'submission_count'};
+ return '' if ($total == 0);
+ my $max_bins = 21;
+ my $min_bin_size = $stats->{'min_abs'};
+ my $low_bin = $stats->{'lowest_ans'}-$stats->{'max_bin_size'};
+ my $high_bin = $stats->{'highest_ans'}+$stats->{'max_bin_size'};
+ if ($high_bin > 0 && $low_bin > -$high_bin) {
+ $low_bin = -$high_bin;
+ } elsif ($low_bin < 0 && $high_bin < -$low_bin) {
+ $high_bin = -$low_bin;
+ }
+ if (($high_bin -$low_bin)/$min_bin_size * 2 > $max_bins) {
+ $min_bin_size = abs($high_bin - $low_bin) / $max_bins * 2;
+ }
+ my @bins;
+ for (my $num = $low_bin;$num <= $high_bin;$num+=($min_bin_size/2)) {
+ push(@bins,$num);
+ }
+ #
+ my @correct;
+ my @incorrect;
+ my @count;
+ while (my ($ans,$submissions) = each(%$responses)) {
+ while (my ($submission,$counts) = each(%$submissions)) {
+ my ($correct_count,$incorrect_count) = @$counts;
+ my $scaled_value = $submission-$ans;
+ if ($scaled_value < $bins[0]) {
+ $bins[0]=$scaled_value-1;
+ }
+ my $bin=0;
+ for ($bin=0;$bin<$#bins;$bin++) {
+ last if ($bins[$bin]>$scaled_value);
+ }
+ $correct[$bin-1]+=$correct_count;
+ $incorrect[$bin-1]+=$incorrect_count;
+ $count[$bin-1]+=$correct_count+$incorrect_count;
+ }
+ }
+ my @plot_correct = @correct;
+ my @plot_incorrect = @incorrect;
+ my $max;
+ for (my $i=0;$i<=$#bins;$i++) {
+ $plot_correct[$i] *= 100/$total;
+ $plot_incorrect[$i] *= 100/$total;
+ if (! defined($max) ||
+ $max < $plot_correct[$i]+$plot_incorrect[$i] ) {
+ $max = $plot_correct[$i]+$plot_incorrect[$i];
+ }
+ }
+ foreach (qw/1 5 10 15 20 25 30 40 50 75 100/) {
+ if ($max <$_) { $max = $_; last; }
+ }
+ #
+ my $title = &mt('Difference between submission and correct');
+ my @labels = (1..scalar(@bins)-1);
+ my $graph = &Apache::loncommon::DrawBarGraph
+ ($title,'Difference from Correct','Percent of Answers',
+ $max,['#33FF00','#FF3300'],\@labels,\@plot_correct,\@plot_incorrect,
+ {xskip=>1});
+ #
+ my $table = $graph.$/.
+ &numerical_bin_table(\@bins,\@labels,\@incorrect,\@correct,\@count).$/;
+ return $table;
+}
- 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;
- }
- } else {
- if($value eq $_) {
- $found = 1;
- last;
- }
+sub numerical_classify_responses {
+ my ($full_row_data,$correct,$function) = @_;
+ my %submission_data;
+ my %students;
+ my %stats;
+ my $max=0;
+ foreach my $row (@$full_row_data) {
+ my %subm = &hashify_attempt($row);
+ if (ref($correct) eq 'HASH') {
+ my $s_correct = $correct->{$subm{'student'}};
+ $subm{'correct'} = $s_correct->{'answer'};
+ foreach my $item ('unit','ans_low','ans_high') {
+ $subm{$item} = $s_correct->{$item};
}
+ } else { # This probably never happens....
+ $subm{'correct'} = $correct->{'answer'};
+ $subm{'unit'} = $correct->{'unit'};
+ }
+ #
+ my $abs_low =abs($subm{'correct'}-$subm{'ans_low'});
+ my $abs_high=abs($subm{'correct'}-$subm{'ans_high'});
+ if (! defined($stats{'min_abs'}) ||
+ $stats{'min_abs'} > $abs_low) {
+ $stats{'min_abs'} = $abs_low;
+ }
+ if ($stats{'min_abs'} > $abs_high) {
+ $stats{'min_abs'} = $abs_high;
+ }
+ if (! defined($stats{'max_abs'}) ||
+ $stats{'max_abs'} < $abs_low) {
+ $stats{'max_abs'} = $abs_low;
+ }
+ if ($stats{'max_abs'} < $abs_high) {
+ $stats{'max_abs'} = $abs_high;
}
- if($found == 0) {
- splice(@$students, $studentIndex, 1);
+ my $low_percent = 100 * abs($abs_low / $subm{'correct'});
+ my $high_percent = 100 * abs($abs_high / $subm{'correct'});
+ if (! defined($stats{'min_percent'}) ||
+ $stats{'min_percent'} > $low_percent) {
+ $stats{'min_percent'} = $low_percent;
+ }
+ if ($stats{'min_percent'} > $high_percent) {
+ $stats{'min_percent'} = $high_percent;
+ }
+ if (! defined($stats{'max_percent'}) ||
+ $stats{'max_percent'} < $low_percent) {
+ $stats{'max_percent'} = $low_percent;
+ }
+ if ($stats{'max_percent'} < $high_percent) {
+ $stats{'max_percent'} = $high_percent;
+ }
+ if (! defined($stats{'lowest_ans'}) ||
+ $stats{'lowest_ans'} > $subm{'correct'}) {
+ $stats{'lowest_ans'} = $subm{'correct'};
+ }
+ if (! defined($stats{'highest_ans'}) ||
+ $stats{'highest_ans'} < $subm{'correct'}) {
+ $stats{'highest_ans'} = $subm{'correct'};
+ }
+ #
+ $subm{'submission'} =~ s/=\d+\s*$//;
+ if (&$function(\%subm)) {
+ my $scaled = '1';
+ my ($sname,$sdom) = split(':',$subm{'student'});
+ my ($myunit,$mysub) = ($subm{'unit'},$subm{'submission'});
+ my $result =
+ &capa::caparesponse_get_real_response($myunit,
+ $mysub,
+ \$scaled);
+# &Apache::lonnet::logthis('scaled = '.$scaled.' result ='.$result);
+ next if (! defined($scaled));
+# next if ($result ne '6');
+ my $submission = $scaled;
+ $students{$subm{'student'}}++;
+ $stats{'submission_count'}++;
+ if (&numerical_submission_is_correct($subm{'award'})) {
+ $stats{'correct_count'}++;
+ $submission_data{$subm{'correct'}}->{$submission}->[0]++;
+ } elsif (&numerical_submission_is_incorrect($subm{'award'})) {
+ $stats{'incorrect_count'}++;
+ $submission_data{$subm{'correct'}}->{$submission}->[1]++;
+ }
}
}
- unless(untie(%cache)) {
- $r->print('Can not untie hash.');
- $r->rflush();
+ $stats{'students'}=scalar(keys(%students));
+ return (\%submission_data,\%stats);
+}
+
+sub numerical_submission_is_correct {
+ my ($award) = @_;
+ if ($award =~ /^(APPROX_ANS|EXACT_ANS)$/) {
+ return 1;
+ } else {
+ return 0;
}
- #if($status eq 'true')
- { &Apache::lonhtmlcommon::Close_PrgWin($r); }
+}
+sub numerical_submission_is_incorrect {
+ my ($award) = @_;
+ if ($award =~ /^(INCORRECT)$/) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
-# my $error =
-# &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
-# 'true',
-# $cacheDB,
-# 'true',
-# 'true',
-# $courseID,
-# $r, $c);
-# if($error ne 'OK') {
-# $r->print($error.'
Error downloading course data
');
-# return;
-# }
-
-
- unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
- $Str .= 'Unable to tie database.';
- $r->print($Str);
- return;
+sub numerical_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];
+ if ($i == 0) { $lownum = '-∞'; }
+ my $highnum = $bins->[$i+1];
+ if ($i == scalar(@{$bins})-2) { $highnum = '∞'; }
+ $table .=
+ ''.
+ ''.$labels->[$i].' | '.
+ ''.$lownum.' | '.
+ ' - | '.
+ ''.$highnum.' | '.
+ ''.$incorrect->[$i].' | '.
+ ''.$correct->[$i].' | '.
+ ''.$count->[$i].' | '.
+ '
'.$/;
}
+ $table.= '
';
+ return $table;
+}
- 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;
+sub numerical_determine_answers {
+ my ($r,$resource,$partid,$respid,$students)=@_;
+ my $c = $r->connection();
+ #
+ my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
+ ($r,'Student Answer Compilation Status',
+ 'Student Answer Compilation Progress', scalar(@$students),
+ 'inline',undef,'Statistics','stats_status');
+ #
+ # 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;
+ foreach my $item ('answer','unit','ans_high','ans_low') {
+ $correct->{$sname.':'.$sdom}->{$item} =
+ $analysis->{$key.'.'.$item}->[0];
+ }
+ $answers{$analysis->{$key.'.answer'}->[0]}++;
+ &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+ &mt('last student'));
+ }
+ &Apache::lonstathelpers::write_analysis_cache();
+ &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+ return ($correct,\%answers);
+}
+
+#
+# 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;
+}
- $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 .= '