# The LearningOnline Network with CAPA # # $Id: lonproblemanalysis.pm,v 1.40 2003/10/16 13:23:13 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(); 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.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('
'); # my ($symb,$part,$resid) = &get_problem_symb( &Apache::lonnet::unescape($ENV{'form.problemchoice'}) ); # my $resource = &get_resource_from_symb($symb); if (defined($resource)) { my %Data = &get_problem_data($resource->{'src'}); my $ORdata = $Data{$part.'.'.$resid}; ## ## 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. '
'); ## ## Analyze the problem my $PerformanceData = &Apache::loncoursedata::get_optionresponse_data (\@Students,$symb,$resid); if (defined($PerformanceData) && ref($PerformanceData) eq 'ARRAY') { if ($ENV{'form.AnalyzeOver'} eq 'Tries') { my $analysis_html = &tries_analysis($PerformanceData, $ORdata); $r->print($analysis_html); } elsif ($ENV{'form.AnalyzeOver'} eq 'Time') { my $analysis_html = &time_analysis($PerformanceData, $ORdata); $r->print($analysis_html); } 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) = @_; 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 = $a; my $b1 = $b; if (exists($Numbers{lc($a)})) { $a1 = $Numbers{lc($a)}; } if (exists($Numbers{lc($b)})) { $b1 = $Numbers{lc($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 ('correct',@{$ORdata->{'Options'}}) { push (@Rows, ''. ''. ''. "\n"); } $table .= join('',reverse(@Rows)); $table .= "
'. (' 'x4).''.$option.'
\n"; } ######################################################### ######################################################### ## ## Tries Analysis ## ######################################################### ######################################################### sub tries_analysis { my ($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($PerformanceData, $mintries,$maxtries); # # Compute the data neccessary to make the plots my @PlotData; # Array which holds the data for each plot # @{$PlotData[$try]->{'datasetname'}} holds the data for # try $try with respect to 'datasetname'. The array is # filled either with per-foil or per-concept data. my ($extrakey,$xlabel,$ylabel); if ($ENV{'form.AnalyzeAs'} eq 'Foils') { $extrakey = &build_option_index($ORdata); $xlabel = 'Foil Number'; $ylabel = 'Option Chosen'; foreach my $foilid (@$Foils) { for (my $i=$mintries;$i<=$maxtries;$i++) { foreach my $option ('_correct',@{$ORdata->{'Options'}}) { push(@{$PlotData[$i]->{'_total'}}, $ResponseData{$foilid}->[$i]->{'_total'}); if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) { push (@{$PlotData[$i]->{$option}},0); } else { push (@{$PlotData[$i]->{$option}}, 100 * $ResponseData{$foilid}->[$i]->{$option} / $ResponseData{$foilid}->[$i]->{'_total'}); } } } } } else { # 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. $extrakey = ''; $xlabel = 'Concept Number'; $ylabel = 'Percent Correct'; 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'}); } } } } # End of work to fill @PlotData # # Build a table for the plots $table .= "\n"; my @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; if ($maxstu == $minstu) { $title = 'Attempt '.$i.', '.$maxstu.' students'; } else { $title = 'Attempt '.$i.', '.$minstu.'-'.$maxstu.' students'; } my @Datasets; foreach my $option ('_correct',@{$ORdata->{'Options'}}) { next if (! exists($PlotData[$i]->{$option})); push(@Datasets,$PlotData[$i]->{$option}); } my $graphlink = &Apache::loncommon::DrawGraph($title, $xlabel, $ylabel, 100, $plotcolors, @Datasets); push(@Plots,$graphlink); } # # Should this be something the user can set? Too many dialogs! while (my $plotlink = shift(@Plots)) { $table .= '\n"; } $table .= "
'.$plotlink.''.$extrakey."
\n"; return ($table); } sub analyze_option_data_by_tries { my ($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 ($grading,$submission,$time,$tries) = @$row; next if ($grading eq 'MISSING_ANSWER'); my @Foilgrades = split('&',$grading); my @Foilsubs = split('&',$submission); for (my $numtries = 1; $numtries <= $maxtries; $numtries++) { if ($tries == $numtries) { for (my $i=0;$i<=$#Foilgrades;$i++) { my ($foilid,$correct) = split('=',$Foilgrades[$i]); my (undef,$submission) = split('=',$Foilsubs[$i]); $submission = &HTML::Entities::decode($submission); $submission =~ s/\%20/ /g; if ($correct) { $Trydata{$foilid}->[$numtries]->{'_correct'}++; } else { $Trydata{$foilid}->[$numtries]->{$submission}++; } $Trydata{$foilid}->[$numtries]->{'_total'}++; } } } } return %Trydata; } ######################################################### ######################################################### ## ## Time Analysis ## ######################################################### ######################################################### sub time_analysis { my ($PerformanceData,$ORdata) = @_; my $num_plots = $ENV{'form.NumPlots'}; my ($table,$Foils,$Concepts) = &build_foil_index($ORdata); my $num_data = scalar(@$PerformanceData)-1; my $percent = sprintf('%2f',100/$num_plots); my $extratable = ''; if ($ENV{'form.AnalyzeAs'} eq 'Foils') { $extratable = &build_option_index($ORdata); } $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); my ($begin_index,$end_index,$plottitle,$plothtml,$data); if (! defined($starttime) || ! defined($endtime)) { $begin_index = $i*int($num_data/$num_plots); $end_index = ($i+1)*int($num_data/$num_plots); my $lownum = sprintf('%2.1f',$i*$percent); $lownum =~ s/(\.0)$//; my $highnum = sprintf('%2.1f',($i+1)*$percent); $highnum =~ s/(\.0)$//; $plottitle = $lownum.'% to '.$highnum.'% of submissions'; } else { my $j; while (++$j < scalar(@$PerformanceData)) { last if ($PerformanceData->[$j]->[2] > $starttime); } $begin_index = $j; while (++$j < scalar(@$PerformanceData)) { last if ($PerformanceData->[$j]->[2] > $endtime); } $end_index = $j; $plottitle = $ENV{'form.plottitle_'.$i}; } ($plothtml,$starttime,$endtime,$data) = &analyze_option_data_by_time($PerformanceData, $begin_index,$end_index, $plottitle,$Foils, $Concepts,$ORdata); my $startdateform = &Apache::lonhtmlcommon::date_setter ('Statistics','startdate_'.$i,$starttime); my $enddateform = &Apache::lonhtmlcommon::date_setter ('Statistics','enddate_'.$i,$endtime); $table.="\n"; } $table .="
".$plothtml.''. "Start Time:  ".$startdateform."
". "End Time  : "." ".$enddateform."
". 'Plot Title  :'.(" "x3). '
'.$extratable. "
\n"; return $table; } sub analyze_option_data_by_time { my ($PerformanceData,$begin_index, $end_index,$description,$Foils,$Concepts,$ORdata) = @_; my %TimeData; # # Get the start and end times for this segment of the plot my $starttime = $PerformanceData->[$begin_index]->[2]; my $endtime = $PerformanceData->[$end_index ]->[2]; # # Compute the number getting the foils correct or incorrects for (my $i=$begin_index;$i<=$end_index;$i++) { my $row = $PerformanceData->[$i]; next if (! defined($row)); my ($grading,$submission,$time,$tries) = @$row; next if ($grading eq 'MISSING_ANSWER'); 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) { $TimeData{$foilid}->{'_correct'}++; } else { $submission = &HTML::Entities::decode($submission); $submission =~ s/\%20/ /g; $TimeData{$foilid}->{$submission}++; } $TimeData{$foilid}->{'_total'}++; } } # # Compute the total and percent correct my @Plotdata; my ($xlabel,$ylabel); if ($ENV{'form.AnalyzeAs'} eq 'Foils') { $xlabel = 'Foil Number'; $ylabel = 'Option Chosen'; foreach my $foil (@$Foils) { my $total = $TimeData{$foil}->{'_total'}; my $optionidx = 0; foreach my $option ('_correct',@{$ORdata->{'Options'}}) { if ($total > 0) { push(@{$Plotdata[$optionidx]}, 100 * $TimeData{$foil}->{$option} / $total); } else { push(@{$Plotdata[$optionidx]},0); } } continue { $optionidx++; } } } else { $xlabel = 'Concept Number'; $ylabel = 'Percent Correct'; foreach my $concept (@$Concepts) { my $correct; my $total; foreach my $foil (@{$concept->{'foils'}}) { $correct+=$TimeData{$foil}->{'_correct'}; $total +=$TimeData{$foil}->{'_total'}; } if ($total > 0) { push(@{$Plotdata[0]},100 * $correct / $total); } else { push(@{$Plotdata[0]},0); } } } # # Create the plot my $graphlink = &Apache::loncommon::DrawGraph ($description,#'Time Interval Analysis', $xlabel, $ylabel, 100, $plotcolors, @Plotdata); # return ($graphlink,$starttime,$endtime,\%TimeData); } ######################################################### ######################################################### ## ## Interface ## ######################################################### ######################################################### sub CreateInterface { ## ## Environment variable initialization if (! exists$ENV{'form.AnalyzeOver'}) { $ENV{'form.AnalyzeOver'} = 'Tries'; } ## ## Build the menu my $Str = ''; $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 .= ''; { # 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; } ## ## 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') { for(my $i=0;$i[$i]=~ s/(\s*$|^\s*)//g; } $Partdata{$part}->{'Options'}=$value; } elsif ($key eq 'concepts') { $Partdata{$part}->{'Concepts'}=$value; } elsif ($key =~ /^concept\.(.*)$/) { my $concept = $1; foreach my $foil (@$value) { $foil =~ s/(\s*$|^\s*)//g; $Partdata{$part}->{'Foils'}->{$foil}->{'Concept'}= $concept; } } } else { $value =~ s/(\s*$|^\s*)//g; if ($key=~ /^foil\.text\.(.*)$/) { my $foil = $1; $foil =~ s/(\s*$|^\s*)//g; $Partdata{$part}->{'Foils'}->{$foil}->{'name'}=$foil; $Partdata{$part}->{'Foils'}->{$foil}->{'text'}=$value; } elsif ($key =~ /^foil\.value\.(.*)$/) { my $foil = $1; $foil =~ s/(\s*$|^\s*)//g; $Partdata{$part}->{'Foils'}->{$foil}->{'value'}=$value; } } } } return %Partdata; } 1; __END__