File:
[LON-CAPA] /
loncom /
interface /
statistics /
lonproblemanalysis.pm
Revision
1.99:
download - view:
text,
annotated -
select for diffs
Fri Oct 29 16:10:30 2004 UTC (20 years, 2 months ago) by
matthew
Branches:
MAIN
CVS tags:
HEAD
RR_create_percent_selected_plot: Fixed bug where if a foil could be true for
some students but not all students the bar for the foil would appear
green (indicating true) for everyone. Now keep track of those for whom
the foil is true seperately than those for whom the foil is false and
produce a stacked bar graph (green & red = true & false).
# The LearningOnline Network with CAPA
#
# $Id: lonproblemanalysis.pm,v 1.99 2004/10/29 16:10:30 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::lonproblemanalysis;
use strict;
use Apache::lonnet();
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();
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 ($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('<h2>There are no students in the sections selected</h2>');
}
#
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("<br />\n");
} else {
$r->print('<input type="submit" name="'.$button->{'name'}.'" '.
'value="'.&mt($button->{'text'}).'" />');
$r->print(' 'x5);
}
}
foreach my $html (@CacheButtonHTML) {
$r->print($html.(' 'x5));
}
#
$r->print('<hr />');
$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('<input type="hidden" name="problemchoice" value="'.
$ENV{'form.problemchoice'}.'" />');
#
if (! defined($current_problem->{'resource'})) {
$r->print('resource is undefined');
} else {
my $resource = $current_problem->{'resource'};
$r->print('<h1>'.$resource->{'title'}.'</h1>');
$r->print('<h3>'.$resource->{'src'}.'</h3>');
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') {
##
## analyze all responses of a problem at once
my $res = $current_problem->{'resource'};
foreach my $partid (@{$res->{'parts'}}) {
$current_problem->{'part'} = $partid;
foreach my $respid (@{$res->{'partdata'}->{$partid}->{'ResponseIds'}}) {
$current_problem->{'respid'}=$respid;
&NumericalResponseAnalysis($r,$current_problem,
$problem_data,\@Students);
}
}
} else {
$r->print('<h2>This analysis is not supported</h2>');
}
}
$r->print('<hr />');
} else {
$r->print('<input type="submit" name="ProblemAnalysis" value="'.
&mt('Analyze Problem').'" />');
$r->print(' 'x5);
$r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
$r->print(&Apache::lonstathelpers::ProblemSelector
($problem_types));
}
}
#########################################################
#########################################################
##
## Numerical Response Routines
##
#########################################################
#########################################################
sub NumericalResponseAnalysis {
my ($r,$problem,$problem_data,$Students) = @_;
my $c = $r->connection();
my ($resource,$partid,$respid) = ($problem->{'resource'},
$problem->{'part'},
$problem->{'respid'});
#
if (scalar(@{$resource->{'parts'}})>1) {
if (@{$resource->{'partdata'}->{$partid}->{'ResponseIds'}}>1) {
$r->print('<h3>'.
&mt('Part [_1], response [_2].',$partid,$respid).
'</h3>');
} else {
$r->print('<h3>'.
&mt('Part [_1]',$partid,$respid).
'</h3>');
}
} elsif (@{$resource->{'partdata'}->{$partid}->{'ResponseIds'}}>1) {
$r->print('<h3>'.&mt('Response [_1]',$respid).'</h3>');
}
#
my $analysis_html;
my $PerformanceData = &Apache::loncoursedata::get_response_data
(\@Apache::lonstatistics::SelectedSections,
$Apache::lonstatistics::enrollment_status,
$resource->{'symb'},$respid);
if (! defined($PerformanceData) ||
ref($PerformanceData) ne 'ARRAY' ) {
$analysis_html = '<h2>'.
&mt('There is no submission data for this resource').
'</h2>';
$r->print($analysis_html);
return;
}
#
# This next call causes all the waiting around that people complain about
&Apache::lonstathelpers::GetStudentAnswers($r,$problem,$Students,
'Statistics',
'stats_status');
return if ($c->aborted());
#
# Collate the data
my %Data;
foreach my $student (@$Students) {
my $answer = $student->{'answer'};
$Data{$answer}++;
}
my @Labels = sort {$a <=> $b } keys(%Data);
my @PlotData = @Data{@Labels};
#
my $width = 500;
my $height = 100;
my $plot = &one_dimensional_plot($r,500,100,scalar(@$Students),
\@Labels,\@PlotData);
$r->print($plot);
return;
}
sub one_dimensional_plot {
my ($r,$width,$height,$N,$Labels,$Data)=@_;
#
# Compute data -> image scaling factors
my $min = $Labels->[0];
my $max = $Labels->[-1];
if ($max == $min) {
$max =$min+1;
}
my $h_scale = ($width-10)/($max-$min);
#
my $max_y = 0;
foreach (@$Data) {
$max_y = $_ if ($max_y < $_);
}
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{<drawimage width="$width" height="$height" bgcolor="transparent" >};
for (my $idx=0;$idx<scalar(@$Labels);$idx++) {
my $xloc = 5+$h_scale*($Labels->[$idx] - $min);
my $top = $height/2-$Data->[$idx]*$ticscale;
my $bottom = $height/2+$Data->[$idx]*$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 < 0 && $max > 0) {
my $circle_x = 5+$h_scale*abs($min); # '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 .= '</drawimage>';
my $plotresult = &Apache::lonxml::xmlparse($r,'web',$plot);
my $title = 'Distribution of correct answers';
my $result = '<table>'.
'<tr><td colspan="3" align="center">'.
'<font size="+2">'.$title.' (N='.$N.')'.
'</font>'.
'</td></tr>'.
'<tr>'.
'<td valign="center">'.$min.'</td>'.
'<td>'.$plotresult.'</td>'.
'<td valign="center">'.$max.'</td>'.
'</tr>'.
'<tr><td colspan="3" align="center">'.
'Maximum Number of Coinciding Values: '.$max_y.
'</td></tr>'.
'</table>';
return $result;
}
##
## Helper subroutines for <drawimage>.
## These should probably go somewhere more suitable soon.
sub line {
my ($x1,$y1,$x2,$y2,$color,$thickness) = @_;
return qq{<line x1="$x1" y1="$y1" x2="$x2" y2="$y2" color="$color" thickness="$thickness" />$/};
}
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 x="$x" y="$y" color="$color" font="$font" direction="$direction" >$text</text>};
}
sub rectangle {
my ($x1,$y1,$x2,$y2,$color,$thickness,$filled) = @_;
return qq{<rectangle x1="$x1" y1="$y1" x2="$x2" y2="$y2" color="$color" thickness="$thickness" filled="$filled" />};
}
sub arc {
my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)=@_;
return qq{<arc x="$x" y="$y" width="$width" height="$height" start="$start" end="$end" color="$color" thickness="$thickness" filled="$filled" />};
}
sub circle {
my ($x,$y,$radius,$color,$thickness,$filled)=@_;
return &arc($x,$y,$radius,$radius,0,360,$color,$thickness,$filled);
}
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;
}
#########################################################
#########################################################
##
## 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'};
}
}
}
#
if (! defined($response_data) || ref($response_data) ne 'ARRAY' ) {
$analysis_html = '<h2>'.
&mt('There is no submission data for this resource').
'</h2>';
$r->print($analysis_html);
return;
}
#
$analysis_html.='<table>';
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 [_5] to [_6], [_2] submissions, [_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)).
'<br />'.
&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 =
&RR_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.= '<tr><td colspan="4" align="center">'.
'<font size="+1">'.
&mt($pre_graph_text,
$plot_num,$foil_choice_data->{'_count'},
$correct,
$foil_choice_data->{'_count'}-$correct,
@extra_data).
'</td></tr>'.$/;
$analysis_html.=
'<tr>'.
'<td>'.$concept_plot.'</td>'.
'<td>'.$choice_plot.'</td>';
if ($stacked_plot ne '') {
$analysis_html .=
'<td>'.$stacked_plot.'</td>'.
'<td>'.&build_foil_key($foils,$count_by_foil).'</td>';
} else {
$analysis_html .= ('<td></td>'x2);
}
$analysis_html.='</tr>'.$/;
if (defined($post_graph_text)) {
$analysis_html.= '<tr><td colspan="4" align="center">'.
$post_graph_text.'</td></tr>'.$/;
}
} elsif ($no_data_text ne '') {
$analysis_html.='<tr><td colspan="4" align="center">'.
&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.='<br />'.$post_graph_text;
}
$analysis_html.='</td></tr>'.$/;
}
} # end of loop for plots
$analysis_html.='</table>';
$r->print($analysis_html);
}
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);
}
sub RR_concept_plot {
my ($concepts,$foil_data,$title) = @_;
#
my %correct_by_concept;
my %incorrect_by_concept;
my %true;
foreach my $concept (@$concepts) {
foreach my $foil (@{$concept->{'foils'}}) {
next if (! exists($foil_data->{$foil}));
foreach my $choice (keys(%{$foil_data->{$foil}})) {
if ($choice eq $foil) {
$correct_by_concept{$concept->{'name'}} +=
$foil_data->{$foil}->{$choice};
} else {
$incorrect_by_concept{$concept->{'name'}} +=
$foil_data->{$foil}->{$choice};
}
}
}
}
#
# 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<scalar(@$concepts);$i++) {
my $concept = $concepts->[$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;
}
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}
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{$foil} += $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<scalar(@$foils);$i++) {
my $foil = $foils->[$i];
$correct[$i] = $correct_selections{$foil};
$incorrect[$i] = $incorrect_selections{$foil};
}
for (my $i=0;$i<=$#correct;$i++) {
&Apache::lonnet::logthis('correct['.$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 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<scalar(@$foils);$i++) {
my $foil = $foils->[$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<scalar(@$foils);$j++) {
my $value = 0;
if ($i != $j ) {
$value += $foil_data->{$foil}->{$foils->[$j]};
}
$dataset[$j]->[$column{$foil}]=$value;
}
}
#
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<scalar(@dataset);$j++) {
$bar_total += $dataset[$j]->[$bar];
}
next if ($bar_total == 0);
for (my $j=0;$j<scalar(@dataset);$j++) {
$dataset[$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);
}
# 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 RR_classify_response_data {
my ($full_row_data,$correct,$function) = @_;
my %submission_data;
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)) {
$submission_data{'_count'}++;
if (&submission_is_correct($subm{'award'})) {
$submission_data{'_correct'}++;
}
$submission_data{$subm{'correct'}}->{$subm{'submission'}}++;
}
}
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('<h2>'.
&mt('There is no student data for this problem.').
'</h2>');
} 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('<h2>'.
&mt('The analysis you have selected is '.
'not supported at this time').
'</h2>');
}
}
}
}
#########################################################
#
# 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);
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 = "<br /><table>\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.= '<tr><td align="center" colspan="4"><b>'.
&mt('None of the selected students attempted the problem more than [_1] times.',$try-1).
'</b></td></tr>';
} else {
$analysis_html.= '<tr><td colspan="4" align="center"><b>'.
&mt('None of the selected students have attempted the problem').'</b></td></tr>';
}
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);
}
#
# 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]);
#
#
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);
$analysis_html.=
'<tr><td colspan="4" align="center">'.
'<font size="+1">'.
&mt('Attempt [_1], [_2] submissions, [_3] correct, [_4] incorrect',
$try,$data_count,$correct,$data_count-$correct).
'</font>'.'</td></tr>'.$/.
'<tr>'.
'<td>'.$concept_graph.'</td>'.
'<td>'.$correct_graph.'</td>'.
'<td>'.$incorrect_graph.'</td>'.
'<td>'.$optionkey.'<td>'.
'</tr>'.$/;
}
$analysis_html .= "</table>\n";
$table .= $analysis_html;
return $table;
}
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;
}
#########################################################
#
# 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 = '<h3>'.
&mt('Not enough data for concept analysis. '.
'Performing Foil Analysis').
'</h3>'.$table;
}
#
my $num_plots = $ENV{'form.NumPlots'};
my $num_data = scalar(@$performance_data)-1;
#
my $current_index;
$table .= "<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 .= '<tr><td colspan="4" align="center"><font size="+1">'.
&mt('Data from [_1] to [_2]',
&Apache::lonlocal::locallocaltime($starttime),
&Apache::lonlocal::locallocaltime($endtime)).
'</font></td></tr>'.$/;
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 .= '<tr><td colspan="4" align="center"><font size="+1">'.
&mt('[_1] submissions from [_2] students submitting, [_3] correct, [_4] incorrect',
$data_count,$student_count,$correct,$data_count-$correct).
'</font></td></tr>'.$/;
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 .= '<tr>'.
'<td>'.$concept_correct_plot.'</td>'.
'<td>'.$foil_correct_plot.'</td>'.
'<td>'.$foil_incorrect_plot.'</td>'.
'<td align="left" valign="top">'.$foilkey.'</td></tr>'.$/;
$table .= '<tr><td colspan="4" align="center">'.
&mt('Start time: [_1]',$startdateform).'<br />'.
&mt('End time: [_1]',$enddateform).'</td></tr>'.$/;
$table.= '<tr><td colspan="4"> </td></tr>'.$/;
}
$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 ('<h2>'.&mt('There is no data to plot').'</h2>','');
}
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<scalar(@{$ORdata->{'_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<scalar(@{$ORdata->{'_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]);
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);
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);
}
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++;
}
&Apache::lonnet::logthis(' '.$begin_index.':'.$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;
}
}
}
&Apache::lonnet::logthis('count = '.$count);
return (\%processed_time_data,$correct,$data_count,
scalar(keys(%distinct_students)));
}
#########################################################
#########################################################
##
## Excel output
##
#########################################################
#########################################################
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('<p>'.&mt("Unable to create new Excel file. ".
"This error has been logged. ".
"Please alert your LON-CAPA administrator").
'</p>');
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 .= '<h2>'.&mt('Excel Raw Data Output').'</h2>'.
'<p><a href="'.$filename.'">'.
&mt('Your Excel spreadsheet.').
'</a></p>'."\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 {
@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);
$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 = '<table border="1" >'."\n";
if (@Concepts > 1) {
$table .= '<tr>'.
'<th>'.&mt('Concept Number').'</th>'.
'<th>'.&mt('Concept').'</th>'.
'<th>'.&mt('Foil Number').'</th>'.
'<th>'.&mt('Foil Name').'</th>'.
'<th>'.&mt('Foil Text').'</th>'.
'<th>'.&mt('Correct Value').'</th>'.
"</tr>\n";
} else {
$table .= '<tr>'.
'<th>'.&mt('Foil Number').'</th>'.
'<th>'.&mt('Foil Name').'</th>'.
'<th>'.&mt('Foil Text').'</th>'.
'<th>'.&mt('Correct Value').'</th>'.
"</tr>\n";
}
my $conceptindex = 1;
my $foilindex = 1;
foreach my $concept (@Concepts) {
my @FoilsInConcept = @{$concept->{'foils'}};
my $firstfoil = shift(@FoilsInConcept);
if (@Concepts > 1) {
$table .= '<tr>'.
'<td>'.$conceptindex.'</td>'.
'<td>'.&HTML::Entities::encode($concept->{'name'},'<>&"').'</td>'.
'<td>'.$foilindex++.'</td>'.
'<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').'</td>'.
'<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
'<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').'</td>'.
"</tr>\n";
} else {
$table .= '<tr>'.
'<td>'.$foilindex++.'</td>'.
'<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').'</td>'.
'<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
'<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').'</td>'.
"</tr>\n";
}
foreach my $foilid (@FoilsInConcept) {
if (@Concepts > 1) {
$table .= '<tr>'.
'<td></td>'.
'<td></td>'.
'<td>'.$foilindex.'</td>'.
'<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').'</td>'.
'<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
'<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'},'<>&"').'</td>'.
"</tr>\n";
} else {
$table .= '<tr>'.
'<td>'.$foilindex.'</td>'.
'<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').'</td>'.
'<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
'<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'},'<>&"').'</td>'.
"</tr>\n";
}
} continue {
$foilindex++;
}
} continue {
$conceptindex++;
}
$table .= "</table>\n";
#
# Build option index with color stuff
return ($table,\@Foils,\@Concepts);
}
sub build_option_index {
my ($ORdata)= @_;
my $table = "<table>\n";
my $optionindex = 0;
my @Rows;
foreach my $option (&mt('correct option chosen'),@{$ORdata->{'_Options'}}) {
my $color = $plotcolors->[$optionindex++];
push (@Rows,
'<tr>'.
'<td bgcolor="'.$color.'">'.
'<font color="'.$color.'">'.('*'x3).'</font>'.'</td>'.
'<td>'.&HTML::Entities::encode($option,'<>&"').'</td>'.
"</tr>\n");
}
shift(@Rows); # Throw away 'correct option chosen' color
$table .= join('',reverse(@Rows));
$table .= "</table>\n";
}
sub build_foil_key {
my ($foils,$extra_data)= @_;
if (! defined($extra_data)) { $extra_data = {}; }
my $table = "<table>\n";
my $foil_index = 0;
my @rows;
foreach my $foil (&mt('correct foil chosen'),@{$foils}) {
my $color = $plotcolors->[$foil_index++];
push (@rows,
'<tr>'.
'<td bgcolor="'.$color.'" class="key">'.
'<font color="'.$color.'">'.('*'x4).'</font></td>'.
'<td>'.&HTML::Entities::encode($foil,'<>&"').
(' 'x2).$extra_data->{$foil}.'</td>'.
"</tr>\n");
}
shift(@rows); # Throw away 'correct foil chosen' color
$table .= join('',reverse(@rows));
$table .= "</table>\n";
}
#########################################################
#########################################################
##
## Generic Interface Routines
##
#########################################################
#########################################################
sub CreateInterface {
##
## Environment variable initialization
if (! exists$ENV{'form.AnalyzeOver'}) {
$ENV{'form.AnalyzeOver'} = 'tries';
}
##
## Build the menu
my $Str = '';
$Str .= &Apache::lonhtmlcommon::breadcrumbs
(undef,'Detailed Problem Analysis');
$Str .= '<table cellspacing="5">'."\n";
$Str .= '<tr>';
$Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
$Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
# $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
$Str .= '<td align="center"> </td>';
$Str .= '</tr>'."\n";
##
##
$Str .= '<tr><td align="center">'."\n";
$Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
$Str .= '</td>';
#
$Str .= '<td align="center">';
$Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
$Str .= '</td>';
#
# $Str .= '<td align="center">';
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 .= '<td>';
##
my $showprob_checkbox =
'<input type="checkbox" name="show_prob" value="true" ';
if ($ENV{'form.show_prob'} eq 'true') {
$showprob_checkbox .= 'checked ';
}
$showprob_checkbox.= ' />';
$Str.= '<nobr><label>'.
&mt('Show problem [_1]',$showprob_checkbox).
'</label></nobr><br />';
##
my $analyze_selector = '<select name="AnalyzeOver" >';
$analyze_selector .= '<option value="tries" ';
if (! exists($ENV{'form.AnalyzeOver'}) ||
$ENV{'form.AnalyzeOver'} eq 'tries'){
# Default to tries
$analyze_selector .= ' selected ';
}
$analyze_selector .= '>'.&mt('Tries').'</option>';
$analyze_selector .= '<option value="time" ';
$analyze_selector .= ' selected ' if ($ENV{'form.AnalyzeOver'} eq 'time');
$analyze_selector .= '>'.&mt('Time').'</option>';
$analyze_selector .= '</select>';
$Str .= '<nobr><label>'.
&mt('Analyze Over [_1] [_2]',
$analyze_selector,
&Apache::loncommon::help_open_topic('Analysis_Analyze_Over')).
'</label></nobr><br />'.$/;
##
my $numplots_selector = '<select name="NumPlots">';
if (! exists($ENV{'form.NumPlots'})
|| $ENV{'form.NumPlots'} < 1
|| $ENV{'form.NumPlots'} > 20) {
$ENV{'form.NumPlots'} = 5;
}
foreach my $i (1,2,3,4,5,6,7,8,10,15,20) {
$numplots_selector .= '<option value="'.$i.'" ';
if ($ENV{'form.NumPlots'} == $i) { $numplots_selector.=' selected '; }
$numplots_selector .= '>'.$i.'</option>';
}
$numplots_selector .= '</select></nobr><br />';
$Str .= '<nobr><label>'.&mt('Number of Plots [_1]',$numplots_selector).
'</label></nobr>';
##
$Str .= '<nobr><label>'.&mt('Status: [_1]',
'<input type="text" '.
'name="stats_status" size="60" value="" />'
).
'</label></nobr>';
$Str .= '</td>';
##
##
$Str .= '</tr>'."\n";
$Str .= '</table>'."\n";
return $Str;
}
#########################################################
#########################################################
##
## Misc Option Response functions
##
#########################################################
#########################################################
sub get_time_from_row {
my ($row) = @_;
if (ref($row)) {
return $row->[&Apache::loncoursedata::RD_timestamp()];
}
return undef;
}
sub get_tries_from_row {
my ($row) = @_;
if (ref($row)) {
return $row->[&Apache::loncoursedata::RD_tries()];
}
return undef;
}
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;
}
sub submission_is_correct {
my ($award) = @_;
if ($award =~ /(APPROX_ANS|EXACT_ANS)/) {
return 1;
} else {
return 0;
}
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonproblemanalysis.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface / statistics