# The LearningOnline Network with CAPA # (Publication Handler # # $Id: lonproblemstatistics.pm,v 1.19 2002/08/13 00:37:18 stredwic 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/ # # (Navigate problems for statistical reports # YEAR=2001 # 5/5,7/9,7/25/1,8/11,9/13,9/26,10/5,10/9,10/22,10/26 Behrouz Minaei # 11/1,11/4,11/16,12/14,12/16,12/18,12/20,12/31 Behrouz Minaei # YEAR=2002 # 1/22,2/1,2/6,2/25,3/2,3/6,3/17,3/21,3/22,3/26,4/7,5/6 Behrouz Minaei # 5/12,5/14,5/15,5/19,5/26,7/16,7/25,7/29,8/5 Behrouz Minaei # ### package Apache::lonproblemstatistics; use strict; use Apache::lonnet(); use Apache::lonhtmlcommon; use Apache::loncoursedata; use GDBM_File; my $jr; sub BuildProblemStatisticsPage { my ($cacheDB, $students, $courseID, $c, $r)=@_; my %cache; $jr = $r; unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { return 'Unable to tie database.'; } my $Ptr = ''; $Ptr .= ''; $Ptr .= ''."\n"; $Ptr .= ''."\n"; $Ptr .= ''."\n"; $Ptr .= ''."\n"; $Ptr .= &ProblemStatisticsButtons($cache{'DisplayFormat'}); $Ptr .= '
Select Map'; $Ptr .= &Apache::lonhtmlcommon::MapOptions(\%cache, 'ProblemStatistics', 'Statistics'); $Ptr .= '
Sorting Type:'."\n"; $Ptr .= &Apache::lonhtmlcommon::AscendOrderOptions( $cache{'ProblemStatisticsAscend'}, 'ProblemStatistics', 'Statistics'); $Ptr .= '
'; $Ptr .= &ProblemStatisticsLegend(); $r->print($Ptr); $r->rflush(); untie(%cache); &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,'true', $cacheDB,'true', 'true',$courseID, $r, $c); if($c->aborted()) { return; } unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { return 'Unable to tie database.'; } my @Header = ("Homework Sets Order","#Stdnts","Tries","Mod", "Mean","#YES","#yes","%Wrng","DoDiff", "S.D.","Skew.","D.F.1st","D.F.2nd","Disc."); my $color=&setbgcolor(0); # my %Discuss=&Apache::loncoursedata::LoadDiscussion($courseID); # my ($upper, $lower) = &Discriminant(\%discriminant,$r); my ($problemData) = &ExtractStudentData(\%cache, $students); &CalculateStatistics($problemData); &SortProblems($problemData, $cache{'ProblemStatisticsSort'}, $cache{'ProblemStatisticsAscend'}); #$TempCache= &BuildStatisticsTable(\%cache, $cache{'DisplayFormat'}, $problemData, \@Header, $r, $color); untie(%cache); # foreach (keys %$TempCache) { # last if ($c->aborted()); # if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) { # $cache{$_}=$TempCache->{$_}; # untie(%cache); # } # } # if($c->aborted()) { return; } # untie(%cache); return; } #---- Problem Statistics Web Page --------------------------------------- sub CreateProblemStatisticsTableHeading { my ($headings,$r)=@_; my $Str=''; $Str .= ''."\n"; $Str .= 'P#'."\n"; foreach(@$headings) { $Str .= ''.''.$_.' '."\n"; } $Str .= "\n".''."\n"; return $Str; } sub BuildStatisticsTable { my ($cache,$displayFormat,$data,$headings,$r,$color)=@_; #6666666 # my $file="/home/httpd/perl/tmp/183d.txt"; # open(OUT, ">$file"); #6666666 ## &Apache::lonstatistics::Create_PrgWin($r); ##777777 ## my (%Activity) = &LoadActivityLog(); ## $r->print(''); ## my ($doDiffFile) = &LoadDoDiffFile(); ##777777 ## $Str .= &Classify($discriminantFactor, $students); my %TempCache; my $problems = $data->{'problemList'}; if($displayFormat ne 'Display CSV Format') { $r->print('
'."\n"); $r->print(''."\n"); $r->print(&CreateProblemStatisticsTableHeading($headings, $r)); } else { $r->print('
'); } my $count = 1; foreach(@$problems) { my ($sequence,$problem,$part)=split(':', $_); # my $problemRef = ''.$cache->{$problem.':title'}.''; my $ref = $cache->{$problem.':title'}; my $title = $cache->{$problem.':title'}; my $source = 'source'; my $tableData = join('&', $ref, $title, $source, $data->{$_.':studentCount'}, $data->{$_.':totalTries'}, $data->{$_.':maxTries'}, sprintf("%.2f", $data->{$_.':mean'}), $data->{$_.':correct'}, $data->{$_.':correctByOverride'}, sprintf("%.1f", $data->{$_.':percentWrong'}), sprintf("%.2f", $data->{$_.':degreeOfDifficulty'}), sprintf("%.1f", $data->{$_.':standardDeviation'}), sprintf("%.1f", $data->{$_.':skewness'}), sprintf("%.2f", $data->{$_.':discriminationFactor1'}), sprintf("%.2f", $data->{$_.':discriminationFactor2'}), 0); # 0 is for discussion, need to figure out # $TempCache{'CacheTable:'.$_}=$join; #6666666 # $r->print('
'.$out.'&'.$DoD); # print (OUT $out.'@'.$DoD.'&'); #6666666 #check with Gerd # $urlres=~/^(\w+)\/(\w+)/; # if ($StdNo) { # &Apache::lonnet::put('nohist_resevaldata',\%storestats, # $1,$2); # } #-------------------------------- Row of statistical table &TableRow($displayFormat,$tableData,$count,$r,$color); # $GraphDat->{'GraphGif:'.($count-1)}=$DoD.':'.$Wrng; $count++; } # $TempCache{'ProblemCount'}=$count; if($cache->{'DisplayFormat'} ne 'Display CSV Format') { $r->print('
'."\n"); } $r->print('
'); #6666666 # close( OUT ); #666666 return \%TempCache; } =pod sub CacheStatisticsTable { my ($state,$cache,$headings,$r,$color)=@_; my @list = (); my %TempCache; my %myHeader = reverse( %$headings ); my $pos = $myHeader{$state}; if ($pos > 0) {$pos++;} my $p_count = $cache->{'ProblemCount'}; for ( my $k=0; $k<$p_count;$k++) { my $key=$cache->{'CacheTable:'.$k}; my @Temp=split(/\&/,$key); $list[$k]=$Temp[$pos].'+'.$key; } if ($pos>0) { @list = sort OrderedSort (@list); } else { @list = sort (@list); } my $cIdx=0; if ( $pos == 0 ) { foreach my $sequence (split(':', $cache->{'orderedSequences'})) { if($cache->{'ProblemStatisticsMaps'} ne 'All Maps' && $cache->{'ProblemStatisticsMaps'} ne $cache->{$sequence.':title'}) { next; } if ($cIdx==$p_count) { return \%TempCache; } $r->print(&CreateProblemStatisticsTableHeading( $cache->{'DisplayFormat'}, $cache->{$sequence.':source'}, $cache->{$sequence.':title'}, $headings,$r)); my ($tar)=split(/\&/,$list[$cIdx]); $tar=~s/\+//eg; my ($SqOrd)=split(/\@/,$tar); $sequence+=100; while ($SqOrd==$sequence && $cIdx<$p_count) { my($Pre, $Post) = split(/\+/,$list[$cIdx]); &TableRow($cache,$Post,$cIdx,$cIdx,$r,$color,\%TempCache); $cIdx++; my ($tar)=split(/\&/,$list[$cIdx]); $tar=~s/\+//eg; ($SqOrd)=split(/\@/,$tar); } &CloseTable($cache,$r); } } else { $r->print(&CreateProblemStatisticsTableHeading( $cache->{'DisplayFormat'}, 'Sorted by: ', $headings->{$pos-1}, $headings,$r)); for ( my $nIndex = 0; $nIndex < $p_count; $nIndex++ ) { my($Pre, $Post) = split(/\+/,$list[$nIndex]); &TableRow($cache,$Post,$nIndex,$nIndex,$r,$color,\%TempCache); } &CloseTable($cache,$r); } return \%TempCache; } =cut sub TableRow { my ($displayFormat,$Str,$RealIdx,$r,$color)=@_; my($ref,$title,$source,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override, $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$DiscNo,$Prob)=split(/\&/,$Str); my $Ptr; if($displayFormat eq 'Display CSV Format') { $Ptr="\n".'
'. "\n".'"'.$RealIdx.'",'. "\n".'"'.$title.'",'. "\n".'"'.$source.'",'. "\n".'"'.$StdNo.'",'. "\n".'"'.$TotalTries.'",'. "\n".'"'.$MxTries.'",'. "\n".'"'.$Avg.'",'. "\n".'"'.$YES.'",'. "\n".'"'.$Override.'",'. "\n".'"'.$Wrng.'",'. "\n".'"'.$DoD.'",'. "\n".'"'.$SD.'",'. "\n".'"'.$Sk.'",'. "\n".'"'.$_D1.'",'. "\n".'"'.$_D2.'"'. "\n".'"'.$DiscNo.'"'; $r->print("\n".$Ptr); } else { $Ptr="\n".''. "\n".''.$RealIdx.''. "\n".''.$ref.''. "\n".' '.$StdNo.''. "\n".''.$TotalTries.''. "\n".''.$MxTries.''. "\n".''.$Avg.''. "\n".' '.$YES.''. "\n".' '.$Override.''. "\n".' '.$Wrng.''. "\n".' '.$DoD.''. "\n".' '.$SD.''. "\n".' '.$Sk.''. "\n".' '.$_D1.''. "\n".' '.$_D2.''. "\n".' '.$DiscNo.''; $r->print("\n".$Ptr.'' ); } return; } # For loading the colored table for display or un-colored for print sub setbgcolor { my $PrintTable=shift; my %color; if ($PrintTable){ $color{"gb"}="#FFFFFF"; $color{"red"}="#FFFFFF"; $color{"yellow"}="#FFFFFF"; $color{"green"}="#FFFFFF"; $color{"purple"}="#FFFFFF"; } else { $color{"gb"}="#DDFFFF"; $color{"red"}="#FFDDDD"; $color{"yellow"}="#EEFFCC"; $color{"green"}="#DDFFDD"; $color{"purple"}="#FFDDFF"; } return \%color; } sub ProblemStatisticsButtons { my ($displayFormat)=@_; my $Ptr = ''; $Ptr .= '{'orderedSequences'})) { if($cache->{'ProblemStatisticsMaps'} ne 'All Maps' && $cache->{'ProblemStatisticsMaps'} ne $cache->{$sequence.':title'}) { next; } foreach my $problemID (split(':', $cache->{$sequence.':problems'})) { foreach my $part (split(/\:/,$cache->{$sequence.':'. $problemID. ':parts'})) { my $id = $sequence.':'.$problemID.':'.$part; push(@problemList, $id); my $totalTries = 0; my $totalAwarded = 0; my $correct = 0; my $correctByOverride = 0; my $studentCount = 0; my $maxTries = 0; my $totalFirst = 0; my @studentTries=(); foreach(@$students) { my $code = $cache->{"$_:$problemID:$part:code"}; if(defined($cache->{$_.':error'}) || $code eq ' ' || $cache->{"$_:$problemID:NoVersion"} eq 'true') { next; } $studentCount++; my $tries = $cache->{"$_:$problemID:$part:tries"}; if($maxTries < $tries) { $maxTries = $tries; } $totalTries += $tries; push(@studentTries, $tries); my $awarded = $cache->{"$_:$problemID:$part:awarded"}; $totalAwarded += $awarded; if($code eq '*') { $correct++; if($tries == 1) { $totalFirst++; } } elsif($code eq '+') { $correctByOverride++; } } $problemData{$id.':sequenceTitle'} = $cache->{$sequence.':title'}; $problemData{$id.':studentCount'} = $studentCount; $problemData{$id.':totalTries'} = $totalTries; $problemData{$id.':studentTries'} = \@studentTries; $problemData{$id.':totalAwarded'} = $totalAwarded; $problemData{$id.':correct'} = $correct; $problemData{$id.':correctByOverride'} = $correctByOverride; $problemData{$id.':wrong'} = $studentCount - ($correct + $correctByOverride); $problemData{$id.':maxTries'} = $maxTries; $problemData{$id.':totalFirst'} = $totalFirst; } } } $problemData{'problemList'} = \@problemList; # $Discussed=0; # if($Discuss->{"$name:$problem"}) { # $TotDiscuss++; # $Discussed=1; # } return \%problemData; } sub SortProblems { my ($problemData,$sortBy,$ascend)=@_; if($sortBy eq "Homework Sets Order") { return; } my $data; if ($sortBy eq "#Stdnts") { $data = ':studentCount'; } elsif($sortBy eq "Tries") { $data = ':totalTries'; } elsif($sortBy eq "Mod") { $data = ':maxTries'; } elsif($sortBy eq "Mean") { $data = ':mean'; } elsif($sortBy eq "#YES") { $data = ':correct'; } elsif($sortBy eq "#yes") { $data = ':correctByOverride'; } elsif($sortBy eq "%Wrng") { $data = ':percentWrong'; } elsif($sortBy eq "DoDiff") { $data = ':degreeOfDifficulty'; } elsif($sortBy eq "S.D.") { $data = ':standardDeviation'; } elsif($sortBy eq "Skew.") { $data = ':skewness'; } elsif($sortBy eq "D.F.1st") { $data = ':discriminantFactor1'; } elsif($sortBy eq "D.F.2nd") { $data = ':discriminantFactor2'; } elsif($sortBy eq "Disc.") { $data = ''; } else { return; } my $problems = $problemData->{'problemList'}; my @orderedProblems = sort { $problemData->{$a.$data} <=> $problemData->{$b.$data} } @$problems; if($ascend eq 'Descending') { @orderedProblems = reverse(@orderedProblems); } $problemData->{'problemList'} = \@orderedProblems; return; } sub CalculateStatistics { my ($data)=@_; my $problems = $data->{'problemList'}; foreach(@$problems) { # Mean $data->{$_.':mean'} = ($data->{$_.':studentCount'}) ? ($data->{$_.':totalTries'} / $data->{$_.':studentCount'}) : 0; # %Wrong $data->{$_.':percentWrong'} = ($data->{$_.':studentCount'}) ? (($data->{$_.':wrong'} / $data->{$_.':studentCount'}) * 100.0) : 100.0; # Degree of Difficulty $data->{$_.':degreeOfDifficulty'} = ($data->{$_.':totalTries'}) ? (1 - (($data->{$_.':correct'} + $data->{$_.':correctByOverride'}) / $data->{$_.':totalTries'})) : 0; # Factor in mean my $studentTries = $data->{$_.':studentTries'}; foreach(my $index=0; $index < scalar(@$studentTries); $index++) { $studentTries->[$index] -= $data->{$_.':mean'}; } my $sumSquared = 0; my $sumCubed = 0; foreach(@$studentTries) { my $squared = ($_ * $_); my $cubed = ($squared * $_); $sumSquared += $squared; $sumCubed += $cubed; } # Standard deviation $data->{$_.':standardDeviation'} = ($data->{$_.':studentCount'} - 1) ? ((sqrt($sumSquared)) / ($data->{$_.':studentCount'} - 1)) : 0; # Skewness my $standardDeviation = $data->{$_.':standardDeviation'}; $data->{$_.':skewness'} = ($data->{$_.':standardDeviation'}) ? (((sqrt($sumSquared)) / $data->{$_.':studentCount'}) / ($standardDeviation * $standardDeviation * $standardDeviation)) : 0; # Discrimination Factor 1 $data->{$_.':discriminationFactor1'} = 0; # Discrimination Factor 2 $data->{$_.':discriminationFactor2'} = 0; } return; } sub ProcessDiscriminant { my ($List) = @_; my @sortedList = sort (@$List); my $Count = scalar @sortedList; my $Problem; my @Dis; my $Slvd=0; my $tmp; my $Sum1=0; my $Sum2=0; my $nIndex=0; my $nStudent=0; my %Proc=undef; while ($nIndex<$Count) { # $jr->print("
$nIndex) $sortedList[$nIndex]"); ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]); @Dis=split(/\+/,$tmp); my $Temp = $Problem; do { $nIndex++; $nStudent++; $Sum1 += $Dis[0]; $Sum2 += $Dis[1]; ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]); @Dis=split(/\+/,$tmp); } while ( $Problem eq $Temp && $nIndex < $Count ); $Proc{$Temp}=($Sum1/$nStudent).':'.($Sum2/$nStudent); # $jr->print("
$nIndex) $Temp --> ($nStudent) $Proc{$Temp}"); $Sum1=0; $Sum2=0; $nStudent=0; } return %Proc; } #------- Creating Discimination factor sub Discriminant { my ($discriminant)=@_; my @discriminantKeys=keys(%$discriminant); my $Count = scalar @discriminantKeys; my $UpCnt = int(0.27*$Count); my $low=0; my $up=$Count-$UpCnt; my @UpList=(); my @LowList=(); $Count=0; foreach my $key (sort(@discriminantKeys)) { $Count++; if($low < $UpCnt || $Count > $up) { $low++; my $str=$discriminant->{$key}; foreach(split(/\&/,$str)){ if($_) { if($low<$UpCnt) { push(@LowList,$_); } else { push(@UpList,$_); } } } } } my %DisUp = &ProcessDiscriminant(\@UpList); my %DisLow = &ProcessDiscriminant(\@LowList); return (\%DisUp, \%DisLow); } #---- END Problem Statistics Web Page ---------------------------------------- #---- Problem Statistics Graph Web Page -------------------------------------- # ------------------------------------------- Prepare data for Graphical chart sub BuildGraphicChart { my ($ylab,$r,$cacheDB)=@_; my %cache; my $Col; my $data=''; my $count = 0; my $Max = 0; unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { return 'Unable to tie database.'; } my $p_count = $cache{'ProblemCount'}; for ( my $k=0; $k<$p_count;$k++) { my @Temp=split(/\:/,$cache{'GraphGif:'.$k}); my $inf = $Temp[$Col]; if ( $Max < $inf ) {$Max = $inf;} $data .= $inf.','; $count++; } untie(%cache); # $r->print("
count=$p_count >>data= $data"); if ( $Max > 1 ) { $Max += (10 - $Max % 10); $Max = int($Max); } else { $Max = 1; } my $cid=$ENV{'request.course.id'}; if ( $ylab eq 'DoDiff Graph' ) { $ylab = 'Degree-of-Difficulty'; $Col = 0; } else { $ylab = 'Wrong-Percentage'; $Col = 1; } my $Course = $ENV{'course.'.$cid.'.description'}; $Course =~ s/\ /"_"/eg; my $GData=$Course.'&'.'Problems#'.'&'.$ylab.'&'. $Max.'&'.$count.'&'.$data; $r->print(''); return; } 1; __END__