# The LearningOnline Network with CAPA # # $Id: lonproblemanalysis.pm,v 1.108 2004/12/06 16:22:21 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(); use capa; my $plotcolors = ['#33ff00', '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933', '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66', ]; my @SubmitButtons = ({ name => 'PrevProblemAnalysis', text => 'Previous Problem' }, { name => 'ProblemAnalysis', text => 'Analyze Problem Again' }, { name => 'NextProblemAnalysis', text => 'Next Problem' }, { name => 'break'}, { name => 'SelectAnother', text => 'Choose a different Problem' }, { name => 'ExcelOutput', text => 'Produce Excel Output' }); sub BuildProblemAnalysisPage { my ($r,$c)=@_; # my %Saveable_Parameters = ('Status' => 'scalar', 'Section' => 'array', 'NumPlots' => 'scalar', 'AnalyzeOver' => 'scalar', ); &Apache::loncommon::store_course_settings('problem_analysis', \%Saveable_Parameters); &Apache::loncommon::restore_course_settings('problem_analysis', \%Saveable_Parameters); # &Apache::lonstatistics::PrepareClasslist(); # $r->print(&CreateInterface()); # my @Students = @Apache::lonstatistics::Students; # if (@Students < 1 && exists($ENV{'form.firstrun'})) { $r->print('

There are no students in the sections selected

'); } # my @CacheButtonHTML = &Apache::lonstathelpers::manage_caches($r,'Statistics','stats_status'); $r->rflush(); # # Support for numerical and radio response isn't complete enough to # include in 1.2 release. my $problem_types = '(option|radiobutton|numerical)'; # my $problem_types = '.';#(option)'; if (exists($ENV{'form.problemchoice'}) && ! exists($ENV{'form.SelectAnother'})) { foreach my $button (@SubmitButtons) { if ($button->{'name'} eq 'break') { $r->print("
\n"); } else { $r->print(''); $r->print(' 'x5); } } foreach my $html (@CacheButtonHTML) { $r->print($html.(' 'x5)); } # $r->print('
'); $r->rflush(); # # Determine which problem we are to analyze my $current_problem = &Apache::lonstathelpers::get_target_from_id ($ENV{'form.problemchoice'}); # my ($prev,$curr,$next) = &Apache::lonstathelpers::get_prev_curr_next($current_problem, $problem_types, 'response', ); if (exists($ENV{'form.PrevProblemAnalysis'}) && defined($prev)) { $current_problem = $prev; } elsif (exists($ENV{'form.NextProblemAnalysis'}) && defined($next)) { $current_problem = $next; } else { $current_problem = $curr; } # # Store the current problem choice and send it out in the form $ENV{'form.problemchoice'} = &Apache::lonstathelpers::make_target_id($current_problem); $r->print(''); # if (! defined($current_problem->{'resource'})) { $r->print('resource is undefined'); } else { my $resource = $current_problem->{'resource'}; $r->print('

'.$resource->{'title'}.'

'); $r->print('

'.$resource->{'src'}.'

'); if ($ENV{'form.show_prob'} eq 'true') { $r->print(&Apache::lonstathelpers::render_resource($resource)); } $r->rflush(); my %Data = &Apache::lonstathelpers::get_problem_data ($resource->{'src'}); my $problem_data = $Data{$current_problem->{'part'}. '.'. $current_problem->{'respid'}}; if ($current_problem->{'resptype'} eq 'option') { &OptionResponseAnalysis($r,$current_problem, $problem_data, \@Students); } elsif ($current_problem->{'resptype'} eq 'radiobutton') { &radio_response_analysis($r,$current_problem, $problem_data, \@Students); } elsif ($current_problem->{'resptype'} eq 'numerical') { &numerical_response_analysis($r,$current_problem, $problem_data,\@Students); } else { $r->print('

Analysis of '.$current_problem->{'resptype'}.' is not supported

'); } } $r->print('
'); } else { $r->print(''); $r->print(' 'x5); $r->print('

'.&mt('Please select a problem to analyze').'

'); $r->print(&Apache::lonstathelpers::ProblemSelector ($problem_types)); } } ######################################################### ######################################################### ## ## Numerical Response Routines ## ######################################################### ######################################################### sub numerical_response_analysis { my ($r,$problem,$problem_analysis,$students) = @_; my $c = $r->connection(); # if ($ENV{'form.AnalyzeOver'} !~ /^(tries|time)$/) { $r->print('Bad request'); } # my ($resource,$partid,$respid) = ($problem->{'resource'}, $problem->{'part'}, $problem->{'respid'}); # Gather student data my $response_data = &Apache::loncoursedata::get_response_data (\@Apache::lonstatistics::SelectedSections, $Apache::lonstatistics::enrollment_status, $resource->{'symb'},$respid); # $problem_analysis->{'answercomputed'} = 1; if ($problem_analysis->{'answercomputed'}) { my $answers = &Apache::lonstathelpers::GetStudentAnswers($r,$problem,$students, 'Statistics', 'stats_status'); $r->print(&numerical_one_dimensional_plot($r,600,150,$answers)); } # if (ref($response_data) ne 'ARRAY') { $r->print('

'. &mt('There is no submission data for this resource'). '

'); return; } my $analysis_html = ''; for (my $plot_num = 1;$plot_num<=$ENV{'form.NumPlots'};$plot_num++) { my $restriction_function; my $header_message; my $stats_message; my $post_message; # passed through &mt sooner rather than later my $no_data_message; my @extra_data; if ($ENV{'form.AnalyzeOver'} eq 'tries') { $restriction_function = sub {($_[0]->{'tries'} == $plot_num?1:0)}; $header_message = 'Attempt [_1]'; $stats_message = '[_1] submissions, [_2] correct, [_3] incorrect'; $post_message = ''; $no_data_message = 'No data exists for attempt [_1]'; } else { my $starttime = &Apache::lonhtmlcommon::get_date_from_form ('startdate_'.$plot_num); my $endtime = &Apache::lonhtmlcommon::get_date_from_form ('enddate_'.$plot_num); ($starttime,$endtime) = &ensure_start_end_times ($starttime,$endtime, &get_time_from_row($response_data->[0]), &get_time_from_row($response_data->[-1]), $plot_num); $header_message = 'Data from [_2] to [_3]'; $extra_data[0] = &Apache::lonlocal::locallocaltime($starttime); $extra_data[1] = &Apache::lonlocal::locallocaltime($endtime); # $stats_message = '[_1] submissions from [_4] students, [_2] correct, [_3] incorrect'; # $post_message = &mt('Start time: [_1]', &Apache::lonhtmlcommon::date_setter ('Statistics','startdate_'.$plot_num,$starttime)). '
'. &mt('End time: [_1]', &Apache::lonhtmlcommon::date_setter ('Statistics','enddate_'.$plot_num,$endtime)); $restriction_function = sub { my $t = $_[0]->{'timestamp'}; if ($t >= $starttime && $t < $endtime) { return 1; } else { return 0; } }; $no_data_message = 'No data for [_2] to [_3]'; } # my ($correct,$answers) = &numerical_determine_answers($r,$resource,$partid, $respid,$students); if ($c->aborted()) { return; }; # my $responses = &numerical_classify_responses($response_data,$correct, $restriction_function); if ($responses->{'_count'} == 0) { $analysis_html.= ''; } else { $analysis_html.= ''. ''. ''.''. ''. ''; } if ($post_message ne '') { $analysis_html .= ''; } } $analysis_html.='
'. &mt($no_data_message,$plot_num,@extra_data). '
'. &mt($header_message,$plot_num,@extra_data). '
'. &mt($stats_message, $responses->{'_count'}, $responses->{'_correct'}, $responses->{'_count'}-$responses->{'_correct'}, $responses->{'_students'}, @extra_data). '
'. &numerical_plot_percent($r,$responses).''. &numerical_plot_differences($r,$responses).'
'.$post_message.'
'; $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'}); # $myunit = 'm'; # # &Apache::lonnet::logthis($myunit); # my $result = # &capa::caparesponse_get_real_response($myunit, # $mysub, # \$scaled); # # &Apache::lonnet::logthis(' '.$myunit.':'.$subm{'unit'}. # # ' '.$mysub.':'.$subm{'submission'}.'; '.$result); # next if (! defined($scaled)); # next if ($result ne '6'); # my $submission = $scaled; my $submission = $subm{'submission'}; $students{$subm{'student'}}++; if (&numerical_submission_is_correct($subm{'award'})) { &Apache::lonnet::logthis('correct:'.$submission.':'.$subm{'correct'}); $submission_data{'_correct'}++; $submission_data{'_count'}++; $submission_data{$subm{'correct'}}->{$submission}->[0]++; } elsif (&numerical_submission_is_incorrect($subm{'award'})) { &Apache::lonnet::logthis('incorrect:'.$submission.':'.$subm{'correct'}); $submission_data{'_count'}++; $submission_data{$subm{'correct'}}->{$submission}->[1]++; } my $value = $submission_data{$subm{'correct'}}->{$submission}->[0]+ $submission_data{$subm{'correct'}}->{$submission}->[1]; if ($max < $value) { $max = $value; } } } $submission_data{'_max'} = $max; $submission_data{'_students'}=scalar(keys(%students)); return \%submission_data; } sub 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 = ''. ''. ''. ''. ''. ''.$/; for (my $i=0;$i[$i-1]; } my $highnum = $bins->[$i]; $table .= ''. ''. ''. ''. ''. ''. ''. ''. ''.$/; } $table.= '
'.&mt('Bar').''.&mt('Range').''.&mt('Incorrect').''.&mt('Correct').''.&mt('Count').'
'.$labels->[$i].''.$lownum.' - '.$highnum.''.$incorrect->[$i].''.$correct->[$i].''.$count->[$i].'
'; 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; } # $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.= ''.$/; $analysis_html.= ''. ''. ''; if ($stacked_plot ne '') { $analysis_html .= ''. ''; } else { $analysis_html .= (''x2); } $analysis_html.=''.$/; if (defined($post_graph_text)) { $analysis_html.= ''.$/; } } elsif ($no_data_text ne '') { $analysis_html.=''.$/; } } # end of loop for plots $analysis_html.='
'. ''. &mt($pre_graph_text, $plot_num,$foil_choice_data->{'_count'}, $correct, $foil_choice_data->{'_count'}-$correct, $foil_choice_data->{'_students'}, @extra_data). '
'.$concept_plot.''.$choice_plot.''.$stacked_plot.''.&build_foil_key($foils,$count_by_foil).'
'. $post_graph_text.'
'. &mt($no_data_text, $plot_num,$foil_choice_data->{'_count'}, $correct, $foil_choice_data->{'_count'}-$correct, @extra_data); if (defined($post_graph_text)) { $analysis_html.='
'.$post_graph_text; } $analysis_html.='
'; $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[$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}=count next if (! exists($foil_data->{$foil})); while (my ($f,$count)= each(%{$foil_data->{$foil}})) { if ($f eq $foil) { $correct_selections{$foil} += $count; } else { $incorrect_selections{$f} += $count; } } } # # need arrays for incorrect and correct because we want to use different # colors for them my @correct; my @incorrect; # my $total = $foil_data->{'_count'}; for (my $i=0;$i[$i]; $correct[$i] = $correct_selections{$foil}; $incorrect[$i] = $incorrect_selections{$foil}; } for (my $i=0;$i<=$#correct;$i++) { $correct[$i] = sprintf('%2f',$correct[$i]/$total*100); } for (my $i=0;$i<=$#incorrect;$i++) { $incorrect[$i] = sprintf('%2f',$incorrect[$i]/$total*100); } # # Put a blank in the data sets between concepts, if there are concepts my @labels; if (defined($concepts) && scalar(@$concepts) > 1) { my @new_correct; my @new_incorrect; my $foil_count = 0; foreach my $concept (@$concepts) { foreach (@{$concept->{'foils'}}) { push(@new_correct, $correct[$foil_count]); push(@new_incorrect,$incorrect[$foil_count]); push(@labels,++$foil_count); } push(@new_correct,''); push(@new_incorrect,''); push(@labels,''); } @correct = @new_correct; @incorrect = @new_incorrect; } else { @labels = (1 .. scalar(@correct)); } # my $xlabel = 'foil chosen'; my $plot= &Apache::loncommon::DrawBarGraph($title, $xlabel, 'Percent Choosing', 100, ['#33ff00','#ff3300'], \@labels, \@correct, \@incorrect); return $plot; } sub RR_create_stacked_selection_plot { my ($foils,$foil_data,$title,$true_foils)=@_; # my @dataset; # array of array refs - multicolor rows $datasets[row]->[col] my @labels; my $count; my %column; # maps foil name to column in @datasets for (my $i=0;$i[$i]; if (defined($true_foils) && scalar(keys(%$true_foils)) > 0 ) { next if (! $true_foils->{$foil} ); push(@labels,$i+1); } else { next if (! exists($foil_data->{$foil})); push(@labels,$i+1); } next if (! exists($foil_data->{$foils->[$i]})); $column{$foil}= $count++; for (my $j=0;$j{$foil}->{$foils->[$j]}; } $dataset[$j]->[$column{$foil}]=$value; } } # return '' if (! scalar(keys(%column))); # my $grand_total = 0; my %count_per_foil; while (my ($foil,$bar) = each (%column)) { my $bar_total = 0; for (my $j=0;$j[$bar]; } next if ($bar_total == 0); for (my $j=0;$j[$bar] = sprintf('%2f',$dataset[$j]->[$bar]/$bar_total * 100); } $count_per_foil{$foil}=' ( '.$bar_total.' )'; $grand_total += $bar_total; } if ($grand_total == 0) { return ('',undef); } my @empty_row = (); foreach (@{$dataset[0]}) { push(@empty_row,0); } # my $graph = &Apache::loncommon::DrawBarGraph ($title,'Correct Foil','foils chosen Incorrectly', 100,$plotcolors,\@labels,\@empty_row,@dataset); return ($graph,\%count_per_foil); } ######################################################### ######################################################### ## ## Misc routines ## ######################################################### ######################################################### # if $correct is a hash ref, it is assumed to be indexed by student names. # the values are assumed to be hash refs with a key of 'answer'. sub classify_response_data { my ($full_row_data,$correct,$function) = @_; my %submission_data; my %students; my $max=0; foreach my $row (@$full_row_data) { my %subm = &hashify_attempt($row); if (ref($correct) eq 'HASH') { $subm{'correct'} = $correct->{$subm{'student'}}; } else { $subm{'correct'} = $correct; } $subm{'submission'} =~ s/=\d+\s*$//; if (&$function(\%subm)) { $students{$subm{'student'}}++; $submission_data{'_count'}++; if (&submission_is_correct($subm{'award'})) { $submission_data{'_correct'}++; } if($max<++$submission_data{$subm{'correct'}}->{$subm{'submission'}}) { $max=$submission_data{$subm{'correct'}}->{$subm{'submission'}}; } } } $submission_data{'_max'} = $max; $submission_data{'_students'}=scalar(keys(%students)); return \%submission_data; } ######################################################### ######################################################### ## ## Option Response Routines ## ######################################################### ######################################################### sub OptionResponseAnalysis { my ($r,$problem,$problem_data,$Students) = @_; my ($resource,$respid) = ($problem->{'resource'}, $problem->{'respid'}); # Note: part data is not needed. my $PerformanceData = &Apache::loncoursedata::get_response_data (\@Apache::lonstatistics::SelectedSections, $Apache::lonstatistics::enrollment_status, $resource->{'symb'},$respid); if (! defined($PerformanceData) || ref($PerformanceData) ne 'ARRAY' ) { $r->print('

'. &mt('There is no student data for this problem.'). '

'); } else { $r->rflush(); if (exists($ENV{'form.ExcelOutput'})) { my $result = &OR_excel_sheet($r,$resource, $PerformanceData, $problem_data); $r->print($result); $r->rflush(); } else { if ($ENV{'form.AnalyzeOver'} eq 'tries') { my $analysis_html = &OR_tries_analysis($r, $PerformanceData, $problem_data); $r->print($analysis_html); $r->rflush(); } elsif ($ENV{'form.AnalyzeOver'} eq 'time') { my $analysis_html = &OR_time_analysis($PerformanceData, $problem_data); $r->print($analysis_html); $r->rflush(); } else { $r->print('

'. &mt('The analysis you have selected is '. 'not supported at this time'). '

'); } } } } ######################################################### # # Option Response: tries Analysis # ######################################################### sub OR_tries_analysis { my ($r,$PerformanceData,$ORdata) = @_; my $mintries = 1; my $maxtries = $ENV{'form.NumPlots'}; my ($table,$Foils,$Concepts) = &build_foil_index($ORdata); if (! defined($Concepts)) { $Concepts = []; } my %response_data = &OR_analyze_by_tries($r,$PerformanceData, $mintries,$maxtries); my $analysis = ''; # # Compute the data necessary to make the plots my @foil_plot; my @concept_data; for (my $j=0;$j<=scalar(@$Concepts);$j++) { my $concept = $Concepts->[$j]; foreach my $foilid (@{$concept->{'foils'}}) { for (my $try=$mintries;$try<=$maxtries;$try++) { # concept analysis data $concept_data[$j]->[$try]->{'_correct'} += $response_data{$foilid}->[$try]->{'_correct'}; $concept_data[$j]->[$try]->{'_total'} += $response_data{$foilid}->[$try]->{'_total'}; # # foil analysis data if ($response_data{$foilid}->[$try]->{'_total'} == 0) { push(@{$foil_plot[$try]->{'_correct'}},0); } else { push(@{$foil_plot[$try]->{'_correct'}}, 100*$response_data{$foilid}->[$try]->{'_correct'}/ $response_data{$foilid}->[$try]->{'_total'}); } foreach my $option (@{$ORdata->{'_Options'}}) { push(@{$foil_plot[$try]->{'_total'}}, $response_data{$foilid}->[$try]->{'_total'}); if ($response_data{$foilid}->[$try]->{'_total'} == 0) { push (@{$foil_plot[$try]->{$option}},0); } else { if ($response_data{$foilid}->[$try]->{'_total'} == $response_data{$foilid}->[$try]->{'_correct'}) { push(@{$foil_plot[$try]->{$option}},0); } else { push (@{$foil_plot[$try]->{$option}}, 100 * $response_data{$foilid}->[$try]->{$option} / ($response_data{$foilid}->[$try]->{'_total'} - $response_data{$foilid}->[$try]->{'_correct'} )); } } } # End of foreach my $option } } # End of foreach my $foilid } # End of concept loops # # Build a table for the plots my $analysis_html = "
\n"; my $optionkey = &build_option_index($ORdata); my $num_concepts = 1; if (defined($Concepts)) { $num_concepts = scalar(@$Concepts); } # for (my $try=$mintries;$try<=$maxtries;$try++) { if (! defined($response_data{'_total'}->[$try]) || $response_data{'_total'}->[$try] == 0) { if ($try > 1) { $analysis_html.= ''; } else { $analysis_html.= ''; } last; } my $concept_graph=''; if ($num_concepts > 1) { # # Create concept plot my @concept_plot_data; for (my $j=0;$j<=$#concept_data;$j++) { my $total = $concept_data[$j]->[$try]->{'_total'}; if ($total == 0) { $concept_plot_data[$j] = 0; } else { $concept_plot_data[$j] = 100 * sprintf('%0.3f', $concept_data[$j]->[$try]->{'_correct'} / $total); } } # $concept_graph = &Apache::loncommon::DrawBarGraph ('Correct Concepts','Concept Number','Percent Correct', 100,$plotcolors,undef,\@concept_plot_data,{xskip=>1}); } # # Create Foil Plots my $data_count = $response_data{'_total'}->[$try]; my $correct = $response_data{'_correct'}->[$try]; my @Datasets; foreach my $option ('_correct',@{$ORdata->{'_Options'}}) { next if (! exists($foil_plot[$try]->{$option})); push(@Datasets,$foil_plot[$try]->{$option}); } # # Put a blank in the data set between concepts for (my $set =0;$set<=$#Datasets;$set++) { my @Data = @{$Datasets[$set]}; my $idx = 0; foreach my $concept (@{$Concepts}) { foreach my $foilid (@{$concept->{'foils'}}) { $Datasets[$set]->[$idx++]=shift(@Data); } if ($concept->{'name'} ne $Concepts->[-1]->{'name'}) { $Datasets[$set]->[$idx++] = 0; } } } # # Set up the labels needed for the bar graph my @Labels; my $idx = 1; foreach my $concept (@{$Concepts}) { foreach my $foilid (@{$concept->{'foils'}}) { push(@Labels,$idx++); } push(@Labels,''); } # my $correct_graph = &Apache::loncommon::DrawBarGraph ('Correct Statements','Statement','% Answered Correct', 100,$plotcolors,\@Labels,$Datasets[0],{xskip=>1}); # # next if (! defined($Datasets[0])); for (my $i=0; $i< scalar(@{$Datasets[0]});$i++) { $Datasets[0]->[$i]=0; } my $count = $response_data{'_total'}->[$try] - $response_data{'_correct'}->[$try]; my $incorrect_graph = &Apache::loncommon::DrawBarGraph ('Incorrect Statements','Statement','% Chosen Incorrectly', 100,$plotcolors,\@Labels,@Datasets,{xskip=>1}); $analysis_html.= ''.$/. ''. ''. ''. ''. ''.$/; } $analysis_html .= "
'. &mt('None of the selected students attempted the problem more than [_1] times.',$try-1). '
'. &mt('None of the selected students have attempted the problem').'
'. ''. &mt('Attempt [_1], [_2] submissions, [_3] correct, [_4] incorrect', $try,$data_count,$correct,$data_count-$correct). ''.'
'.$concept_graph.''.$correct_graph.''.$incorrect_graph.''.$optionkey.''. '
\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 = '

'. &mt('Not enough data for concept analysis. '. 'Performing Foil Analysis'). '

'.$table; } # my $num_plots = $ENV{'form.NumPlots'}; my $num_data = scalar(@$performance_data)-1; # my $current_index; $table .= "\n"; for (my $i=0;$i<$num_plots;$i++) { ## my $starttime = &Apache::lonhtmlcommon::get_date_from_form ('startdate_'.$i); my $endtime = &Apache::lonhtmlcommon::get_date_from_form ('enddate_'.$i); if (! defined($starttime) || ! defined($endtime)) { my $sec_in_day = 86400; my $last_sub_time = &get_time_from_row($performance_data->[-1]); my ($sday,$smon,$syear) = (localtime($last_sub_time - $sec_in_day*$i))[3..5]; $starttime = &Time::Local::timelocal(0,0,0,$sday,$smon,$syear); $endtime = $starttime + $sec_in_day; if ($i == ($num_plots -1 )) { $starttime = &get_time_from_row($performance_data->[0]); } } $table .= ''.$/; 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 .= ''.$/; 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 .= ''. ''. ''. ''. ''.$/; $table .= ''.$/; $table.= ''.$/; } $table .= '
'. &mt('Data from [_1] to [_2]', &Apache::lonlocal::locallocaltime($starttime), &Apache::lonlocal::locallocaltime($endtime)). '
'. &mt('[_1] submissions from [_2] students, [_3] correct, [_4] incorrect', $data_count,$student_count,$correct,$data_count-$correct). '
'.$concept_correct_plot.''.$foil_correct_plot.''.$foil_incorrect_plot.''.$foilkey.'
'. &mt('Start time: [_1]',$startdateform).'
'. &mt('End time: [_1]',$enddateform).'
 
'; # return $table; } sub OR_Foil_Time_Analysis { my ($processed_time_data,$correct,$data_count,$student_count, $ORdata,$Foils,$Concepts) = @_; if ($data_count <= 0) { return ('

'.&mt('There is no data to plot').'

',''); } my $analysis_html; my @plotdata; my @labels; foreach my $concept (@{$Concepts}) { foreach my $foil (@{$concept->{'foils'}}) { push(@labels,scalar(@labels)+1); my $total = $processed_time_data->{$foil}->{'_total'}; if ($total == 0) { push(@{$plotdata[0]},0); } else { push(@{$plotdata[0]}, 100 * $processed_time_data->{$foil}->{'_correct'} / $total); } my $total_incorrect = $total - $processed_time_data->{$foil}->{'_correct'}; for (my $i=0;$i{'_Options'}});$i++) { my $option = $ORdata->{'_Options'}->[$i]; if ($total_incorrect == 0) { push(@{$plotdata[$i+1]},0); } else { push(@{$plotdata[$i+1]}, 100 * $processed_time_data->{$foil}->{$option} / $total_incorrect); } } } # Put in a blank one push(@labels,''); push(@{$plotdata[0]},0); for (my $i=0;$i{'_Options'}});$i++) { push(@{$plotdata[$i+1]},0); } } # # Create the plot my $correct_plot = &Apache::loncommon::DrawBarGraph('Correct Statements', 'Statement Number', 'Percent Correct', 100, $plotcolors, undef, $plotdata[0], {xskip=>1}); for (my $j=0; $j< scalar(@{$plotdata[0]});$j++) { $plotdata[0]->[$j]=0; } my $incorrect_plot = &Apache::loncommon::DrawBarGraph('Incorrect Statements', 'Statement Number', 'Incorrect Option Choice', 100, $plotcolors, undef, @plotdata,{xskip=>1}); return ($correct_plot,$incorrect_plot); } sub OR_Concept_Time_Analysis { my ($processed_time_data,$correct,$data_count,$student_count, $ORdata,$Concepts) = @_; return '' if ($data_count == 0); # # Put the data in plottable form my @plotdata; foreach my $concept (@$Concepts) { my ($total,$correct); foreach my $foil (@{$concept->{'foils'}}) { $total += $processed_time_data->{$foil}->{'_total'}; $correct += $processed_time_data->{$foil}->{'_correct'}; } if ($total == 0) { push(@plotdata,0); } else { push(@plotdata,100 * $correct / $total); } } # # Create the plot return &Apache::loncommon::DrawBarGraph('Correct Concepts', 'Concept Number', 'Percent Correct', 100, $plotcolors, undef, \@plotdata,{xskip=>1}); } sub OR_time_process_data { my ($performance_data,$begin_index,$end_index)=@_; my %processed_time_data; my %distinct_students; my ($correct,$data_count); if (($begin_index == $end_index) && ($end_index != scalar(@$performance_data)-1)) { return undef; } # Be sure we include the last one if we are asked for it. # That we have to correct here (and not when $end_index is # given a value) should probably be considered a bug. if ($end_index == scalar(@$performance_data)-1) { $end_index++; } my $count; for (my $i=$begin_index;$i<$end_index;$i++) { my $attempt = $performance_data->[$i]; $count++; next if (! defined($attempt)); my %attempt = &Process_OR_Row($attempt); $data_count++; $correct += $attempt{'_correct'}; $distinct_students{$attempt->[&Apache::loncoursedata::RD_student_id()]}++; while (my ($foilid,$href) = each(%attempt)) { if (! ref($href)) { $processed_time_data{$foilid} += $href; next; } while (my ($option,$value) = each(%$href)) { $processed_time_data{$foilid}->{$option}+=$value; } } } return (\%processed_time_data,$correct,$data_count, scalar(keys(%distinct_students))); } ######################################################### ######################################################### ## ## Excel output ## ######################################################### ######################################################### sub build_student_data_worksheet { my ($workbook,$format) = @_; my $rows_output = 3; my $cols_output = 0; my $worksheet = $workbook->addworksheet('Student Data'); $worksheet->write($rows_output++,0,'Student Data',$format->{'h3'}); my @Headers = ('full name','username','domain','section', "student\nnumber",'identifier'); $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'}); my @Students = @Apache::lonstatistics::Students; my $studentrows = &Apache::loncoursedata::get_student_data(\@Students); my %ids; foreach my $row (@$studentrows) { my ($mysqlid,$student) = @$row; $ids{$student}=$mysqlid; } foreach my $student (@Students) { my $name_domain = $student->{'username'}.':'.$student->{'domain'}; $worksheet->write_row($rows_output++,0, [$student->{'fullname'}, $student->{'username'},$student->{'domain'}, $student->{'section'},$student->{'id'}, $ids{$name_domain}]); } return $worksheet; } sub OR_excel_sheet { my ($r,$resource,$performance_data,$ORdata) = @_; my $response = ''; my (undef,$Foils,$Concepts) = &build_foil_index($ORdata); # # Create excel worksheet my $filename = '/prtspool/'. $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. time.'_'.rand(1000000000).'.xls'; my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); if (! defined($workbook)) { $r->log_error("Error creating excel spreadsheet $filename: $!"); $r->print('

'.&mt("Unable to create new Excel file. ". "This error has been logged. ". "Please alert your LON-CAPA administrator"). '

'); return undef; } # $workbook->set_tempdir('/home/httpd/perl/tmp'); my $format = &Apache::loncommon::define_excel_formats($workbook); # # Create and populate main worksheets my $problem_data_sheet = $workbook->addworksheet('Problem Data'); my $student_data_sheet = &build_student_data_worksheet($workbook,$format); my $response_data_sheet = $workbook->addworksheet('Response Data'); foreach my $sheet ($problem_data_sheet,$student_data_sheet, $response_data_sheet) { $sheet->write(0,0,$resource->{'title'},$format->{'h2'}); $sheet->write(1,0,$resource->{'src'},$format->{'h3'}); } # my $result; $result = &OR_build_problem_data_worksheet($problem_data_sheet,$format, $Concepts,$ORdata); if ($result ne 'okay') { # Do something useful } $result = &OR_build_response_data_worksheet($response_data_sheet,$format, $performance_data,$Foils, $ORdata); if ($result ne 'okay') { # Do something useful } $response_data_sheet->activate(); # # Close the excel file $workbook->close(); # # Write a link to allow them to download it $result .= '

'.&mt('Excel Raw Data Output').'

'. '

'. &mt('Your Excel spreadsheet.'). '

'."\n"; return $result; } sub OR_build_problem_data_worksheet { my ($worksheet,$format,$Concepts,$ORdata) = @_; my $rows_output = 3; my $cols_output = 0; $worksheet->write($rows_output++,0,'Problem Structure',$format->{'h3'}); ## ## my @Headers; if (@$Concepts > 1) { @Headers = ("Concept\nNumber",'Concept',"Foil\nNumber", 'Foil Name','Foil Text','Correct value'); } else { @Headers = ('Foil Number','FoilName','Foil Text','Correct value'); } $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'}); my %Foildata = %{$ORdata->{'_Foils'}}; my $conceptindex = 1; my $foilindex = 1; foreach my $concept (@$Concepts) { my @FoilsInConcept = @{$concept->{'foils'}}; my $firstfoil = shift(@FoilsInConcept); if (@$Concepts > 1) { $worksheet->write_row($rows_output++,0, [$conceptindex, $concept->{'name'}, $foilindex++, $Foildata{$firstfoil}->{'name'}, $Foildata{$firstfoil}->{'text'}, $Foildata{$firstfoil}->{'value'},]); } else { $worksheet->write_row($rows_output++,0, [ $foilindex++, $Foildata{$firstfoil}->{'name'}, $Foildata{$firstfoil}->{'text'}, $Foildata{$firstfoil}->{'value'},]); } foreach my $foilid (@FoilsInConcept) { if (@$Concepts > 1) { $worksheet->write_row($rows_output++,0, ['', '', $foilindex, $Foildata{$foilid}->{'name'}, $Foildata{$foilid}->{'text'}, $Foildata{$foilid}->{'value'},]); } else { $worksheet->write_row($rows_output++,0, [$foilindex, $Foildata{$foilid}->{'name'}, $Foildata{$foilid}->{'text'}, $Foildata{$foilid}->{'value'},]); } } continue { $foilindex++; } } continue { $conceptindex++; } $rows_output++; $rows_output++; ## ## Option data output $worksheet->write($rows_output++,0,'Options',$format->{'header'}); foreach my $string (@{$ORdata->{'_Options'}}) { $worksheet->write($rows_output++,0,$string); } return 'okay'; } sub OR_build_response_data_worksheet { my ($worksheet,$format,$performance_data,$Foils,$ORdata)=@_; my $rows_output = 3; my $cols_output = 0; $worksheet->write($rows_output++,0,'Response Data',$format->{'h3'}); $worksheet->set_column(1,1,20); $worksheet->set_column(2,2,13); my @Headers = ('identifier','time','award detail','attempt'); foreach my $foil (@$Foils) { push (@Headers,$foil.' submission'); push (@Headers,$foil.' grading'); } $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'}); # foreach my $row (@$performance_data) { next if (! defined($row)); my ($student,$award,$grading,$submission,$time,$tries) = @$row; my @Foilgrades = split('&',$grading); my @Foilsubs = split('&',$submission); my %response_data; for (my $j=0;$j<=$#Foilgrades;$j++) { my ($foilid,$correct) = split('=',$Foilgrades[$j]); my (undef,$submission) = split('=',$Foilsubs[$j]); $submission = &Apache::lonnet::unescape($submission); $foilid = &Apache::lonnet::unescape($foilid); $response_data{$foilid.' submission'}=$submission; $response_data{$foilid.' award'}=$correct; } $worksheet->write($rows_output,$cols_output++,$student); $worksheet->write($rows_output,$cols_output++, &Apache::lonstathelpers::calc_serial($time),$format->{'date'}); $worksheet->write($rows_output,$cols_output++,$award); $worksheet->write($rows_output,$cols_output++,$tries); foreach my $foilid (@$Foils) { $worksheet->write($rows_output,$cols_output++, $response_data{$foilid.' submission'}); $worksheet->write($rows_output,$cols_output++, $response_data{$foilid.' award'}); } $rows_output++; $cols_output = 0; } return; } sub build_foil_index { my ($ORdata) = @_; return if (! exists($ORdata->{'_Foils'})); my %Foildata = %{$ORdata->{'_Foils'}}; my @Foils = sort(keys(%Foildata)); my %Concepts; foreach my $foilid (@Foils) { push(@{$Concepts{$Foildata{$foilid}->{'_Concept'}}}, $foilid); } undef(@Foils); # Having gathered the concept information in a hash, we now translate it # into an array because we need to be consistent about order. # Also put the foils in order, too. my $sortfunction = sub { my %Numbers = (one => 1, two => 2, three => 3, four => 4, five => 5, six => 6, seven => 7, eight => 8, nine => 9, ten => 10,); my $a1 = lc($a); my $b1 = lc($b); if (exists($Numbers{$a1})) { $a1 = $Numbers{$a1}; } if (exists($Numbers{$b1})) { $b1 = $Numbers{$b1}; } if (($a1 =~/^\d+$/) && ($b1 =~/^\d+$/)) { return $a1 <=> $b1; } else { return $a1 cmp $b1; } }; my @Concepts; foreach my $concept (sort $sortfunction (keys(%Concepts))) { if (! defined($Concepts{$concept})) { $Concepts{$concept}=[]; # next; } push(@Concepts,{ name => $concept, foils => [@{$Concepts{$concept}}]}); push(@Foils,(@{$Concepts{$concept}})); } # # Build up the table of row labels. my $table = ''."\n"; if (@Concepts > 1) { $table .= ''. ''. ''. ''. ''. ''. ''. "\n"; } else { $table .= ''. ''. ''. ''. ''. "\n"; } my $conceptindex = 1; my $foilindex = 1; foreach my $concept (@Concepts) { my @FoilsInConcept = @{$concept->{'foils'}}; my $firstfoil = shift(@FoilsInConcept); if (@Concepts > 1) { $table .= ''. ''. ''. ''. ''. ''. ''. "\n"; } else { $table .= ''. ''. ''. ''. ''. "\n"; } foreach my $foilid (@FoilsInConcept) { if (@Concepts > 1) { $table .= ''. ''. ''. ''. ''. ''. ''. "\n"; } else { $table .= ''. ''. ''. ''. ''. "\n"; } } continue { $foilindex++; } } continue { $conceptindex++; } $table .= "
'.&mt('Concept Number').''.&mt('Concept').''.&mt('Foil Number').''.&mt('Foil Name').''.&mt('Foil Text').''.&mt('Correct Value').'
'.&mt('Foil Number').''.&mt('Foil Name').''.&mt('Foil Text').''.&mt('Correct Value').'
'.$conceptindex.''.&HTML::Entities::encode($concept->{'name'},'<>&"').''.$foilindex++.''.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').''.$Foildata{$firstfoil}->{'text'}.''.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').'
'.$foilindex++.''.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').''.$Foildata{$firstfoil}->{'text'}.''.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').'
'.$foilindex.''.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').''.$Foildata{$foilid}->{'text'}.''.&HTML::Entities::encode($Foildata{$foilid}->{'value'},'<>&"').'
'.$foilindex.''.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').''.$Foildata{$foilid}->{'text'}.''.&HTML::Entities::encode($Foildata{$foilid}->{'value'},'<>&"').'
\n"; # # Build option index with color stuff return ($table,\@Foils,\@Concepts); } sub build_option_index { my ($ORdata)= @_; my $table = "\n"; my $optionindex = 0; my @Rows; foreach my $option (&mt('correct option chosen'),@{$ORdata->{'_Options'}}) { my $color = $plotcolors->[$optionindex++]; push (@Rows, ''. ''. ''. "\n"); } shift(@Rows); # Throw away 'correct option chosen' color $table .= join('',reverse(@Rows)); $table .= "
'. ''.('*'x3).''.''.&HTML::Entities::encode($option,'<>&"').'
\n"; } sub build_foil_key { my ($foils,$extra_data)= @_; if (! defined($extra_data)) { $extra_data = {}; } my $table = "\n"; my $foil_index = 0; my @rows; foreach my $foil (&mt('correct foil chosen'),@{$foils}) { my $color = $plotcolors->[$foil_index++]; push (@rows, ''. ''. ''. "\n"); } shift(@rows); # Throw away 'correct foil chosen' color $table .= join('',reverse(@rows)); $table .= "
'. ''.('*'x4).''.&HTML::Entities::encode($foil,'<>&"'). (' 'x2).$extra_data->{$foil}.'
\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 .= ''."\n"; $Str .= ''; $Str .= ''; $Str .= ''; # $Str .= ''; $Str .= ''; $Str .= ''."\n"; ## ## $Str .= ''; # $Str .= ''; # # $Str .= ''; ## ## $Str .= ''."\n"; $Str .= '
'.&mt('Sections').''.&mt('Enrollment Status').''.&mt('Sequences and Folders').' 
'."\n"; $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5); $Str .= ''; $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5); $Str .= ''; my $only_seq_with_assessments = sub { my $s=shift; if ($s->{'num_assess'} < 1) { return 0; } else { return 1; } }; &Apache::lonstatistics::MapSelect('Maps','multiple,all',5, $only_seq_with_assessments); ## ## $Str .= ''; ## my $showprob_checkbox = '
'; ## my $analyze_selector = ''; $Str .= '
'.$/; ## my $numplots_selector = '
'; $Str .= ''; ## $Str .= ''; $Str .= '
'."\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__