'.
- # Oh this is dumb! Need to rewrite relative links
- # otherwise images (for example) will not show.
- &Apache::lonnet::ssi_body($resource->{'src'}).
- '
');
+ $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('
';
+ }
+ if ($post_message ne '') {
+ $analysis_html .=
+ '
'.$post_message.'
';
+ }
+ }
+ $analysis_html.='
';
+ $r->print($analysis_html);
+ #
+ return;
+}
+
+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;
+}
+
+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;
+}
+
+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'});
+ my $result =
+ &capa::caparesponse_get_real_response($myunit,
+ $mysub,
+ \$scaled);
+ next if (! defined($scaled));
+ next if ($result ne '6');
+ my $submission = $scaled;
+ $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 numerical_submission_is_correct {
+ my ($award) = @_;
+ &Apache::lonnet::logthis('award = "'.$award.'"');
+ if ($award =~ /^(APPROX_ANS|EXACT_ANS)$/) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+sub numerical_submission_is_incorrect {
+ my ($award) = @_;
+ if ($award =~ /^(INCORRECT)$/) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+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;
+}
+
+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);
+}
+
+#
+# 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);
+}
+
+#########################################################
+#########################################################
+##
+## 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;
}
- # Okay, they asked for data, so make sure we get the latest data.
- &Apache::lonnet::logthis('got here for some reason');
-# &Apache::lonstatistics::Gather_Full_Student_Data($r);
- $r->print(&OptionResponseProblemSelector());
+ #
+ $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.= '