';
+ }
+ if ($post_message ne '') {
+ $analysis_html .=
+ '
'.$post_message.'
';
+ }
}
+ $analysis_html.='
';
+ $r->print($analysis_html);
+ #
+ return;
+}
- $r->print(&IntervalOptions($cache{'Interval'}));
- $r->rflush();
- $r->print(&OptionResponseTable($cache{'OptionResponses'}, \%cache));
+sub numerical_plot_percent {
+ my ($r,$responses) = @_;
+ #
+ my $total = $responses->{'_count'};
+ return '' if ($total == 0);
+ my $minbin = 0.5;
+ while (my ($interval,$submissions) = each(%$responses)) {
+ next if ($interval =~ /^_/);
+ my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+ my $low_percent = abs(($ans-$ans_low)/$ans);
+ my $high_percent = abs(($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;
+sub numerical_classify_responses {
+ 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)) {
+ my $submission = $subm{'submission'};
+ $students{$subm{'student'}}++;
+ if (&numerical_submission_is_correct($subm{'award'})) {
+ $submission_data{'_correct'}++;
+ $submission_data{'_count'}++;
+ $submission_data{$subm{'correct'}}->{$submission}->[0]++;
+ } elsif (&numerical_submission_is_incorrect($subm{'award'})) {
+ $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,$r)=@_;
+sub numerical_submission_is_correct {
+ my ($award) = @_;
+ if ($award =~ /^(APPROX_ANS|EXACT_ANS)$/) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
-# $jr = $r;
- my $c = $r->connection;
+sub numerical_submission_is_incorrect {
+ my ($award) = @_;
+ if ($award =~ /^(INCORRECT)$/) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
- my $Str = '';
- my %cache;
- &Create_PrgWin($r);
- my $count=0;
- foreach (@$students) {
- &Update_PrgWin(scalar(@$students),$count,$_,$r);
- if($c->aborted) {
- return $Str;
- }
- my $downloadTime='';
- if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
- $downloadTime = $cache{$_.':lastDownloadTime'};
- untie(%cache);
- }
- if($downloadTime eq 'Not downloaded') {
- my $courseData =
- &Apache::loncoursedata::DownloadCourseInformation($_,
- $courseID);
- if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
- &Apache::loncoursedata::ProcessStudentData(\%cache,
- $courseData, $_);
- untie(%cache);
- } else {
- next;
- }
+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];
}
- $count++;
+ my $highnum = $bins->[$i];
+ $table .=
+ '
'.
+ '
'.$labels->[$i].'
'.
+ '
'.$lownum.'
'.
+ '
-
'.
+ '
'.$highnum.'
'.
+ '
'.$incorrect->[$i].'
'.
+ '
'.$correct->[$i].'
'.
+ '
'.$count->[$i].'
'.
+ '
'.$/;
}
- &Close_PrgWin($r);
+ $table.= '
';
+ return $table;
+}
- unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
- $Str .= 'Unable to tie database.';
- return $Str;
+sub numerical_response_determine_intervals {
+ 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;
+ # %intervals differs from %answers because it may be possible for two
+ # students to have the same correct answer but different intervals.
+ my %intervals;
+ 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;
+ my $interval = join(' ',($analysis->{$key.'.answer'}->[0],
+ $analysis->{$key.'.ans_low'}->[0],
+ $analysis->{$key.'.ans_high'}->[0]));
+ $correct->{$sname.':'.$sdom} = $interval;
+ $intervals{$interval}++;
+ $answers{$analysis->{$key.'.answer'}->[0]}++;
}
+ &Apache::lonstathelpers::write_analysis_cache();
+ return ($correct,\%intervals,\%answers);
+}
- 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'};
+#
+# 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 $h_scale = ($width-10)/($max_x-$min_x);
+ #
+ 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;
+}
- my %ConceptData;
- $ConceptData{"Interval"} = $interval;
+##
+## Helper subroutines for .
+## These should probably go somewhere more suitable soon.
+sub line {
+ my ($x1,$y1,$x2,$y2,$color,$thickness) = @_;
+ return qq{};
+}
- #Initialize the option response true answers
- my ($analyzeData) = &InitAnalysis($uri, $part, $responseId, $problem,
- $students->[0], $courseID);
- if(defined($analyzeData->{'error'})) {
- $Str .= 'Incorrect part requested. ';
- return $Str;
+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};
+}
- if($c->aborted()) { untie(%cache); return $Str; }
+sub rectangle {
+ my ($x1,$y1,$x2,$y2,$color,$thickness,$filled) = @_;
+ return qq{};
+}
- #compute the intervals
- &Interval($part, $problem, $interval, $analyzeData->{'concepts'},
- \%ConceptData);
+sub arc {
+ my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)=@_;
+ return qq{};
+}
- $title =~ s/\ /"_"/eg;
- $Str .= ' '.$uri.'';
+sub circle {
+ my ($x,$y,$radius,$color,$thickness,$filled)=@_;
+ return &arc($x,$y,$radius,$radius,0,360,$color,$thickness,$filled);
+}
- if($c->aborted()) { untie(%cache); return $Str; }
-
- #Java script Progress window
-# &Create_PrgWin();
-# &Update_PrgWin("Starting-to-analyze-problem");
- for(my $index=0; $index<(scalar @$students); $index++) {
- if($c->aborted()) { untie(%cache); return $Str; }
-# &Update_PrgWin($index);
-# &OpStatus($problem, $students->[$index], $courseID, \%ConceptData,
-# $analyzeData->{'foil_to_concept'}, $analyzeData, \%cache);
- &OpStatus($problem, $students->[$index], \%ConceptData,
- $analyzeData->{'foil_to_concept'}, $analyzeData, \%cache);
+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}]);
}
-# &Close_PrgWin();
+ return $worksheet;
+}
- $Str .= ' ';
- for (my $k=0; $k<$interval; $k++ ) {
- if($c->aborted()) { untie(%cache); return $Str; }
- $Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'},
- \%ConceptData);
+#########################################################
+#########################################################
+##
+## 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);
+ #
+ 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'};
+ }
+ }
}
- for (my $k=0; $k<$interval; $k++ ) {
- if($c->aborted()) { untie(%cache); return $Str; }
- $Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData);
+ #
+ 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;
}
- my $Answ=&Apache::lonnet::ssi($uri);
- $Str .= ' Here you can see the Problem: '.$Answ;
-
- untie(%cache);
-
- return $Str.'