# The LearningOnline Network with CAPA # # $Id: lonproblemanalysis.pm,v 1.44 2003/10/21 16:00: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 HTML::Entities(); use Time::Local(); use Spreadsheet::WriteExcel(); my $plotcolors = ['#33ff00', '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933', '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66', ]; sub BuildProblemAnalysisPage { my ($r,$c)=@_; $r->print('

'.&mt('Option Response Problem Analysis').'

'); $r->print(&CreateInterface()); # my @Students = @Apache::lonstatistics::Students; # if (exists($ENV{'form.ClearCache'}) || exists($ENV{'form.updatecaches'}) || (exists($ENV{'form.firstanalysis'}) && $ENV{'form.firstanalysis'} ne 'no')) { &Apache::lonstatistics::Gather_Full_Student_Data($r); } if (! exists($ENV{'form.firstanalysis'})) { $r->print(''); } else { $r->print(''); } $r->rflush(); if (exists($ENV{'form.problemchoice'}) && ! exists($ENV{'form.SelectAnother'})) { $r->print(''); $r->print(' 'x5); $r->print(''); $r->print(' 'x5); $r->print(''); $r->print(' 'x5); $r->print(''); $r->print(''); $r->print(' 'x5); $r->print(''); $r->print(' 'x5); # $r->print('
'); # my ($symb,$part,$resid) = &get_problem_symb( &Apache::lonnet::unescape($ENV{'form.problemchoice'}) ); $r->rflush(); # my $resource = &get_resource_from_symb($symb); if (defined($resource)) { $r->print('

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

'); $r->print('

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

'); $r->rflush(); my %Data = &get_problem_data($resource->{'src'}); my $PerformanceData = &Apache::loncoursedata::get_optionresponse_data (\@Students,$symb,$resid); my $ORdata = $Data{$part.'.'.$resid}; if (exists($ENV{'form.ExcelOutput'}) && defined($PerformanceData)) { my $result = &prepare_excel_sheet($r,$resource, $PerformanceData,$ORdata); $r->print($result); $r->rflush(); } ## ## Render the problem my $base; ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|); $base = "http://".$ENV{'SERVER_NAME'}.$base; my $rendered_problem = &Apache::lonnet::ssi_body($resource->{'src'}); $rendered_problem =~ s/<\s*form\s*/)|<\/nop>|g; $r->print('
'. ''. $rendered_problem. '
'); $r->rflush(); if (! exists($ENV{'form.ExcelOutput'})) { ## ## Analyze the problem if (defined($PerformanceData) && ref($PerformanceData) eq 'ARRAY') { if ($ENV{'form.AnalyzeOver'} eq 'Tries') { my $analysis_html = &tries_analysis($r, $PerformanceData, $ORdata); $r->print($analysis_html); $r->rflush(); } elsif ($ENV{'form.AnalyzeOver'} eq 'Time') { my $analysis_html = &time_analysis($PerformanceData, $ORdata); $r->print($analysis_html); $r->rflush(); } else { $r->print('

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

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

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

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

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

'); $r->print(&OptionResponseProblemSelector()); } } ######################################################### ######################################################### ## ## Misc interface routines use by analysis code ## ######################################################### ######################################################### 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{$a})) { $a1 = $Numbers{$a}; } if (exists($Numbers{$b})) { $b1 = $Numbers{$b}; } $a1 cmp $b1; }; my @Concepts; foreach my $concept (sort $sortfunction (keys(%Concepts))) { 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.''.$concept->{'name'}.''.$foilindex++.''.$Foildata{$firstfoil}->{'name'}.''.$Foildata{$firstfoil}->{'text'}.''.$Foildata{$firstfoil}->{'value'}.'
'.$foilindex++.''.$Foildata{$firstfoil}->{'name'}.''.$Foildata{$firstfoil}->{'text'}.''.$Foildata{$firstfoil}->{'value'}.'
'.$foilindex.''.$Foildata{$foilid}->{'name'}.''.$Foildata{$foilid}->{'text'}.''.$Foildata{$foilid}->{'value'}.'
'.$foilindex.''.$Foildata{$foilid}->{'name'}.''.$Foildata{$foilid}->{'text'}.''.$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'}}) { push (@Rows, ''. ''. ''. "\n"); } shift(@Rows); # Throw away 'correct option chosen' color $table .= join('',reverse(@Rows)); $table .= "
'. (' 'x4).''.$option.'
\n"; } ######################################################### ######################################################### ## ## Tries Analysis ## ######################################################### ######################################################### sub tries_analysis { my ($r,$PerformanceData,$ORdata) = @_; my $mintries = 1; my $maxtries = $ENV{'form.NumPlots'}; my ($table,$Foils,$Concepts) = &build_foil_index($ORdata); if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) { $table = '

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

'.$table; $ENV{'form.AnalyzeAs'} = 'Foils'; } my %ResponseData = &analyze_option_data_by_tries($r,$PerformanceData, $mintries,$maxtries); my $analysis = ''; if ($ENV{'form.AnalyzeAs'} eq 'Foils') { $analysis = &Tries_Foil_Analysis($mintries,$maxtries,$Foils, \%ResponseData,$ORdata); } else { $analysis = &Tries_Concept_Analysis($mintries,$maxtries, $Concepts,\%ResponseData,$ORdata); } $table .= $analysis; return $table; } sub Tries_Foil_Analysis { my ($mintries,$maxtries,$Foils,$respdat,$ORdata) = @_; my %ResponseData = %$respdat; # # Compute the data neccessary to make the plots my @PlotData; foreach my $foilid (@$Foils) { for (my $i=$mintries;$i<=$maxtries;$i++) { if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) { push(@{$PlotData[$i]->{'_correct'}},0); } else { push(@{$PlotData[$i]->{'_correct'}}, 100*$ResponseData{$foilid}->[$i]->{'_correct'}/ $ResponseData{$foilid}->[$i]->{'_total'}); } foreach my $option (@{$ORdata->{'Options'}}) { push(@{$PlotData[$i]->{'_total'}}, $ResponseData{$foilid}->[$i]->{'_total'}); if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) { push (@{$PlotData[$i]->{$option}},0); } else { if ($ResponseData{$foilid}->[$i]->{'_total'} == $ResponseData{$foilid}->[$i]->{'_correct'}) { push(@{$PlotData[$i]->{$option}},0); } else { push (@{$PlotData[$i]->{$option}}, 100 * $ResponseData{$foilid}->[$i]->{$option} / ($ResponseData{$foilid}->[$i]->{'_total'} - $ResponseData{$foilid}->[$i]->{'_correct'})); } } } } } # # Build a table for the plots my $analysis_html = "\n"; my $foilkey = &build_option_index($ORdata); for (my $i=$mintries;$i<=$maxtries;$i++) { my $count = $ResponseData{'_total'}->[$i]; if ($count == 0) { $count = 'no submissions'; } elsif ($count == 1) { $count = '1 submission'; } else { $count = $count.' submissions'; } my $title = 'Attempt '.$i.', '.$count; my @Datasets; foreach my $option ('_correct',@{$ORdata->{'Options'}}) { next if (! exists($PlotData[$i]->{$option})); push(@Datasets,$PlotData[$i]->{$option}); } my $correctgraph = &Apache::loncommon::DrawGraph ($title,'Foil Number','Percent Correct', 100,$plotcolors,$Datasets[0]); $analysis_html.= ''; ## ## for (my $i=0; $i< scalar(@{$Datasets[0]});$i++) { $Datasets[0]->[$i]=0; } $count = $ResponseData{'_total'}->[$i]-$ResponseData{'_correct'}->[$i]; if ($count == 0) { $count = 'no submissions'; } elsif ($count == 1) { $count = '1 submission'; } else { $count = $count.' submissions'; } $title = 'Attempt '.$i.', '.$count; my $incorrectgraph = &Apache::loncommon::DrawGraph ($title,'Foil Number','% Option Chosen Incorrectly', 100,$plotcolors,@Datasets); $analysis_html.= ''; $analysis_html.= '\n"; } $analysis_html .= "
'.$correctgraph.''.$incorrectgraph.''.$foilkey."
\n"; return $analysis_html; } sub Tries_Concept_Analysis { my ($mintries,$maxtries,$Concepts,$respdat,$ORdata) = @_; my %ResponseData = %$respdat; my $analysis_html = "\n"; # # Compute the data neccessary to make the plots my @PlotData; # Concept analysis # # Note: we do not bother with characterizing the students incorrect # answers at the concept level because an incorrect answer for one foil # may be a correct answer for another foil. my %ConceptData; foreach my $concept (@{$Concepts}) { for (my $i=$mintries;$i<=$maxtries;$i++) { # # Gather the per-attempt data my $cdata = $ConceptData{$concept}->[$i]; foreach my $foilid (@{$concept->{'foils'}}) { $cdata->{'_correct'} += $ResponseData{$foilid}->[$i]->{'_correct'}; $cdata->{'_total'} += $ResponseData{$foilid}->[$i]->{'_total'}; } push (@{$PlotData[$i]->{'_total'}},$cdata->{'_total'}); if ($cdata->{'_total'} == 0) { push (@{$PlotData[$i]->{'_correct'}},0); } else { push (@{$PlotData[$i]->{'_correct'}}, 100*$cdata->{'_correct'}/$cdata->{'_total'}); } } } # Build a table for the plots for (my $i=$mintries;$i<=$maxtries;$i++) { my $minstu = $PlotData[$i]->{'_total'}->[0]; my $maxstu = $PlotData[$i]->{'_total'}->[0]; foreach my $count (@{$PlotData[$i]->{'_total'}}) { if ($minstu > $count) { $minstu = $count; } if ($maxstu < $count) { $maxstu = $count; } } $maxstu = 0 if (! defined($maxstu)); $minstu = 0 if (! defined($minstu)); my $title; my $count = $ResponseData{'_total'}->[$i]; if ($count == 0) { $count = 'no submissions'; } elsif ($count == 1) { $count = '1 submission'; } else { $count = $count.' submissions'; } $title = 'Attempt '.$i.', '.$count; my $graphlink = &Apache::loncommon::DrawGraph ($title,'Concept Number','Percent Correct', 100,$plotcolors,$PlotData[$i]->{'_correct'}); $analysis_html.= '\n"; } $analysis_html .= "
'.$graphlink."
\n"; return $analysis_html; } sub analyze_option_data_by_tries { my ($r,$PerformanceData,$mintries,$maxtries) = @_; my %Trydata; $mintries = 1 if (! defined($mintries) || $mintries < 1); $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries); foreach my $row (@$PerformanceData) { next if (! defined($row)); my $tries = &get_tries_from_row($row); my %Row = &Process_Row($row); next if (! %Row); 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; } } } return %Trydata; } ######################################################### ######################################################### ## ## Time Analysis ## ######################################################### ######################################################### sub time_analysis { my ($PerformanceData,$ORdata) = @_; my ($table,$Foils,$Concepts) = &build_foil_index($ORdata); if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) { $table = '

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

'.$table; $ENV{'form.AnalyzeAs'} = 'Foils'; } my $num_plots = $ENV{'form.NumPlots'}; my $num_data = scalar(@$PerformanceData)-1; my $percent = sprintf('%2f',100/$num_plots); # $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($PerformanceData->[-1]); my ($sday,$smon,$syear); (undef,undef,undef,$sday,$smon,$syear) = localtime($last_sub_time - $sec_in_day*$i); $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($PerformanceData->[0]); } } 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(@$PerformanceData)) { last if (&get_time_from_row($PerformanceData->[$j]) > $starttime); } $begin_index = $j; while (++$j < scalar(@$PerformanceData)) { last if (&get_time_from_row($PerformanceData->[$j]) > $endtime); } $end_index = $j; ## my $interval = { begin_index => $begin_index, end_index => $end_index, startdateform => $startdateform, enddateform => $enddateform, }; if ($ENV{'form.AnalyzeAs'} eq 'Foils') { $table .= &Foil_Time_Analysis($PerformanceData,$ORdata,$Foils, $interval); } else { $table .= &Concept_Time_Analysis($PerformanceData,$ORdata, $Concepts,$interval); } } # return $table; } sub Foil_Time_Analysis { my ($PerformanceData,$ORdata,$Foils,$interval) = @_; my $analysis_html; my $foilkey = &build_option_index($ORdata); my ($begin_index,$end_index) = ($interval->{'begin_index'}, $interval->{'end_index'}); my %TimeData; # # Compute the number getting the foils correct or incorrects for (my $j=$begin_index;$j<=$end_index;$j++) { my $row = $PerformanceData->[$j]; next if (! defined($row)); my %Row = &Process_Row($row); while (my ($foilid,$href) = each(%Row)) { if (! ref($href)) { $TimeData{$foilid} += $href; next; } while (my ($option,$value) = each(%$href)) { $TimeData{$foilid}->{$option}+=$value; } } } my @Plotdata; foreach my $foil (@$Foils) { my $total = $TimeData{$foil}->{'_total'}; if ($total == 0) { push(@{$Plotdata[0]},0); } else { push(@{$Plotdata[0]}, 100 * $TimeData{$foil}->{'_correct'} / $total); } my $total_incorrect = $total - $TimeData{$foil}->{'_correct'}; my $optionidx = 1; foreach my $option (@{$ORdata->{'Options'}}) { if ($total_incorrect == 0) { push(@{$Plotdata[$optionidx]},0); } else { push(@{$Plotdata[$optionidx]}, 100 * $TimeData{$foil}->{$option} / $total_incorrect); } } continue { $optionidx++; } } # # Create the plot my $count = $end_index-$begin_index; my $title; if ($count == 0) { $title = 'no submissions'; } elsif ($count == 1) { $title = 'one submission'; } else { $title = $count.' submissions'; } my $correctplot = &Apache::loncommon::DrawGraph($title, 'Foil Number', 'Percent Correct', 100, $plotcolors, $Plotdata[0]); for (my $j=0; $j< scalar(@{$Plotdata[0]});$j++) { $Plotdata[0]->[$j]=0; } $count = $end_index-$begin_index-$TimeData{'_correct'}; if ($count == 0) { $title = 'no submissions'; } elsif ($count == 1) { $title = 'one submission'; } else { $title = $count.' submissions'; } my $incorrectplot = &Apache::loncommon::DrawGraph($title, 'Foil Number', 'Incorrect Option Choice', 100, $plotcolors, @Plotdata); $analysis_html.=''. ''. ''. ''."\n"; $analysis_html.= ''.''. "\n"; return $analysis_html; } sub Concept_Time_Analysis { my ($PerformanceData,$ORdata,$Concepts,$interval) = @_; my $analysis_html; ## ## Determine starttime, endtime, startindex, endindex my ($begin_index,$end_index) = ($interval->{'begin_index'}, $interval->{'end_index'}); my %TimeData; # # Compute the number getting the foils correct or incorrects for (my $j=$begin_index;$j<=$end_index;$j++) { my $row = $PerformanceData->[$j]; next if (! defined($row)); my %Row = &Process_Row($row); while (my ($foilid,$href) = each(%Row)) { if (! ref($href)) { $TimeData{$foilid} += $href; next; } while (my ($option,$value) = each(%$href)) { $TimeData{$foilid}->{$option}+=$value; } } } # # Put the data in plottable form my @Plotdata; foreach my $concept (@$Concepts) { my ($total,$correct); foreach my $foil (@{$concept->{'foils'}}) { $total += $TimeData{$foil}->{'_total'}; $correct += $TimeData{$foil}->{'_correct'}; } if ($total == 0) { push(@Plotdata,0); } else { push(@Plotdata,100 * $correct / $total); } } # # Create the plot my $title = ($end_index - $begin_index).' submissions'; my $correctplot = &Apache::loncommon::DrawGraph($title, 'Concept Number', 'Percent Correct', 100, $plotcolors, \@Plotdata); $analysis_html.=''. ''. ''. "\n"; return $analysis_html; } ######################################################### ######################################################### ## ## Excel output ## ######################################################### ######################################################### sub prepare_excel_sheet { my ($r,$resource,$PerformanceData,$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'); # # Define some potentially useful formats my $format; $format->{'header'} = $workbook->add_format(bold => 1, bottom => 1, align => 'center'); $format->{'bold'} = $workbook->add_format(bold=>1); $format->{'h1'} = $workbook->add_format(bold=>1, size=>18); $format->{'h2'} = $workbook->add_format(bold=>1, size=>16); $format->{'h3'} = $workbook->add_format(bold=>1, size=>14); $format->{'date'} = $workbook->add_format(num_format=> 'mmm d yyyy hh:mm AM/PM'); # # Create and populate main worksheets my $problem_data_sheet = $workbook->addworksheet('Problem Data'); my $student_data_sheet = $workbook->addworksheet('Student Data'); 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 = &build_problem_data_worksheet($problem_data_sheet,$format, $Concepts,$ORdata); if ($result ne 'okay') { # Do something useful } $result = &build_student_data_worksheet($student_data_sheet,$format); if ($result ne 'okay') { # Do something useful } $result = &build_response_data_worksheet($response_data_sheet,$format, $PerformanceData,$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 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 build_student_data_worksheet { my ($worksheet,$format) = @_; my $rows_output = 3; my $cols_output = 0; $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; } sub build_response_data_worksheet { my ($worksheet,$format,$PerformanceData,$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 (@$PerformanceData) { next if (! defined($row)); my ($student,$award,$grading,$submission,$time,$tries) = @$row; my @Foilgrades = split('&',$grading); my @Foilsubs = split('&',$submission); my %ResponseData; for (my $j=0;$j<=$#Foilgrades;$j++) { my ($foilid,$correct) = split('=',$Foilgrades[$j]); my (undef,$submission) = split('=',$Foilsubs[$j]); $submission = &Apache::lonnet::unescape($submission); $ResponseData{$foilid.' submission'}=$submission; $ResponseData{$foilid.' award'}=$correct; } $worksheet->write($rows_output,$cols_output++,$student); $worksheet->write($rows_output,$cols_output++, &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++, $ResponseData{$foilid.' submission'}); $worksheet->write($rows_output,$cols_output++, $ResponseData{$foilid.' award'}); } $rows_output++; $cols_output = 0; } return; } ## ## The following is copied from datecalc1.pl, part of the ## Spreadsheet::WriteExcel CPAN module. ## ## ###################################################################### # # Demonstration of writing date/time cells to Excel spreadsheets, # using UNIX/Perl time as source of date/time. # # Copyright 2000, Andrew Benham, adsb@bigfoot.com # ###################################################################### # # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970) # measured in seconds. # # An Excel file can use exactly one of two different date/time systems. # In these systems, a floating point number represents the number of days # (and fractional parts of the day) since a start point. The floating point # number is referred to as a 'serial'. # The two systems ('1900' and '1904') use different starting points: # '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as # a leap year - see: # http://support.microsoft.com/support/kb/articles/Q181/3/70.asp # for the excuse^H^H^H^H^H^Hreason. # '1904'; '1.00' is 2 Jan 1904. # # The '1904' system is the default for Apple Macs. Windows versions of # Excel have the option to use the '1904' system. # # Note that Visual Basic's "DateSerial" function does NOT erroneously # regard 1900 as a leap year, and thus its serials do not agree with # the 1900 serials of Excel for dates before 1 Mar 1900. # # Note that StarOffice (at least at version 5.2) does NOT erroneously # regard 1900 as a leap year, and thus its serials do not agree with # the 1900 serials of Excel for dates before 1 Mar 1900. # ###################################################################### # # Calculation description # ======================= # # 1900 system # ----------- # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900. # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68) # were leap years with an extra day. # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and # 1 Jan 1970. # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'. # # 1904 system # ----------- # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904. # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68) # were leap years with an extra day. # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and # 1 Jan 1970. # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'. # ###################################################################### # # Copyright (c) 2000, Andrew Benham. # This program is free software. It may be used, redistributed and/or # modified under the same terms as Perl itself. # # Andrew Benham, adsb@bigfoot.com # London, United Kingdom # 11 Nov 2000 # ###################################################################### # Use 1900 date system on all platforms other than Apple Mac (for which # use 1904 date system). my $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0; #----------------------------------------------------------- # calc_serial() # # Called with (up to) 2 parameters. # 1. Unix timestamp. If omitted, uses current time. # 2. GMT flag. Set to '1' to return serial in GMT. # If omitted, returns serial in appropriate timezone. # # Returns date/time serial according to $DATE_SYSTEM selected #----------------------------------------------------------- sub calc_serial { my $time = (defined $_[0]) ? $_[0] : time(); my $gmtflag = (defined $_[1]) ? $_[1] : 0; # Divide timestamp by number of seconds in a day. # This gives a date serial with '0' on 1 Jan 1970. my $serial = $time / 86400; # Adjust the date serial by the offset appropriate to the # currently selected system (1900/1904). if ($DATE_SYSTEM == 0) { # use 1900 system $serial += 25569; } else { # use 1904 system $serial += 24107; } unless ($gmtflag) { # Now have a 'raw' serial with the right offset. But this # gives a serial in GMT, which is false unless the timezone # is GMT. We need to adjust the serial by the appropriate # timezone offset. # Calculate the appropriate timezone offset by seeing what # the differences between localtime and gmtime for the given # time are. my @gmtime = gmtime($time); my @ltime = localtime($time); # For the first 7 elements of the two arrays, adjust the # date serial where the elements differ. for (0 .. 6) { my $diff = $ltime[$_] - $gmtime[$_]; if ($diff) { $serial += _adjustment($diff,$_); } } } # Perpetuate the error that 1900 was a leap year by decrementing # the serial if we're using the 1900 system and the date is prior to # 1 Mar 1900. This has the effect of making serial value '60' # 29 Feb 1900. # This fix only has any effect if UNIX/Perl time on the platform # can represent 1900. Many can't. unless ($DATE_SYSTEM) { $serial-- if ($serial < 61); # '61' is 1 Mar 1900 } return $serial; } sub _adjustment { # Based on the difference in the localtime/gmtime array elements # number, return the adjustment required to the serial. # We only look at some elements of the localtime/gmtime arrays: # seconds unlikely to be different as all known timezones # have an offset of integral multiples of 15 minutes, # but it's easy to do. # minutes will be different for timezone offsets which are # not an exact number of hours. # hours very likely to be different. # weekday will differ when localtime/gmtime difference # straddles midnight. # # Assume that difference between localtime and gmtime is less than # 5 days, then don't have to do maths for day of month, month number, # year number, etc... my ($delta,$element) = @_; my $adjust = 0; if ($element == 0) { # Seconds $adjust = $delta/86400; # 60 * 60 * 24 } elsif ($element == 1) { # Minutes $adjust = $delta/1440; # 60 * 24 } elsif ($element == 2) { # Hours $adjust = $delta/24; # 24 } elsif ($element == 6) { # Day of week number # Catch difference straddling Sat/Sun in either direction $delta += 7 if ($delta < -4); $delta -= 7 if ($delta > 4); $adjust = $delta; } return $adjust; } ######################################################### ######################################################### ## ## Interface ## ######################################################### ######################################################### sub CreateInterface { ## ## Environment variable initialization if (! exists$ENV{'form.AnalyzeOver'}) { $ENV{'form.AnalyzeOver'} = 'Tries'; } ## ## Build the menu my $Str = ''; $Str .= '
'.$correctplot.''.$incorrectplot.''.$foilkey.'
'. 'Start Time:'. '  '.$interval->{'startdateform'}.'
'. 'End Time  : '. ' '.$interval->{'enddateform'}.'
'. # 'Plot Title  :'. # (" "x3).$interval->{'titleform'}. '
'.$correctplot.''. 'Start Time:  '.$interval->{'startdateform'}.'
'. 'End Time  : '. ' '.$interval->{'enddateform'}.'
'. # 'Plot Title  :'.(" "x3). # $interval->{'titleform'}. '
'."\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 .= ''; { # These braces are here to organize the code, not scope it. { $Str .= ''.&mt('Analyze Over '); $Str .='
'; } { $Str .= ''.&mt('Analyze as '); $Str .='
'; } { $Str .= '
'.&mt('Number of Plots:'); $Str .= ''; } } $Str .= '
'."\n"; return $Str; } sub OptionResponseProblemSelector { my $Str; $Str = "\n\n"; foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) { next if ($seq->{'num_assess'}<1); my $seq_str = ''; foreach my $res (@{$seq->{'contents'}}) { next if ($res->{'type'} ne 'assessment'); foreach my $part (@{$res->{'parts'}}) { my $partdata = $res->{'partdata'}->{$part}; if (! exists($partdata->{'option'}) || $partdata->{'option'} == 0) { next; } for (my $i=0;$i{'ResponseTypes'}});$i++){ my $respid = $partdata->{'ResponseIds'}->[$i]; my $resptype = $partdata->{'ResponseTypes'}->[$i]; if ($resptype eq 'option') { my $value = &Apache::lonnet::escape($res->{'symb'}.':'.$part.':'.$respid); my $checked = ''; if ($ENV{'form.problemchoice'} eq $value) { $checked = 'checked '; } $seq_str .= '\n"; } } } } if ($seq_str ne '') { $Str .= ''. "\n".$seq_str; } } $Str .= "
'. ''. ''. ''.$res->{'title'}.' '; if ($partdata->{'option'} > 1) { $seq_str .= &mt('response').' '.$respid; } $seq_str .= "
 '.$seq->{'title'}.'
\n"; return $Str; } ######################################################### ######################################################### ## ## Misc functions ## ######################################################### ######################################################### sub get_problem_symb { my $problemstring = shift(); my ($symb,$partid,$resid) = ($problemstring=~ /^(.*):([^:]*):([^:]*)$/); return ($symb,$partid,$resid); } sub get_resource_from_symb { my ($symb) = @_; foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) { foreach my $res (@{$seq->{'contents'}}) { if ($res->{'symb'} eq $symb) { return $res; } } } return undef; } sub get_time_from_row { my ($row) = @_; if (ref($row)) { return $row->[3]; } return undef; } sub get_tries_from_row { my ($row) = @_; if (ref($row)) { return $row->[5]; } return undef; } sub Process_Row { my ($row) = @_; my %RowData; my ($student_id,$award,$grading,$submission,$time,$tries) = @$row; return undef if ($award eq 'MISSING_ANSWER'); if ($award =~ /(APPROX_ANS|EXACT_ANS)/) { $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]); 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; } ## ## get problem data and put it into a useful data structure. ## note: we must force each foil and option to not begin or end with ## spaces as they are stored without such data. ## sub get_problem_data { my ($url) = @_; my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze')); (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2); my %Answer; %Answer=&Apache::lonnet::str2hash($Answ); my %Partdata; foreach my $part (@{$Answer{'parts'}}) { while (my($key,$value) = each(%Answer)) { next if ($key !~ /^$part/); $key =~ s/^$part\.//; if (ref($value) eq 'ARRAY') { if ($key eq 'options') { $Partdata{$part}->{'Options'}=$value; } elsif ($key eq 'concepts') { $Partdata{$part}->{'Concepts'}=$value; } elsif ($key =~ /^concept\.(.*)$/) { my $concept = $1; foreach my $foil (@$value) { $Partdata{$part}->{'Foils'}->{$foil}->{'Concept'}= $concept; } } } else { if ($key=~ /^foil\.text\.(.*)$/) { my $foil = $1; $Partdata{$part}->{'Foils'}->{$foil}->{'name'}=$foil; $value =~ s/(\s*$|^\s*)//g; $Partdata{$part}->{'Foils'}->{$foil}->{'text'}=$value; } elsif ($key =~ /^foil\.value\.(.*)$/) { my $foil = $1; $Partdata{$part}->{'Foils'}->{$foil}->{'value'}=$value; } } } } return %Partdata; } 1; __END__