--- loncom/interface/statistics/lonproblemstatistics.pm 2002/08/13 12:21:46 1.20 +++ loncom/interface/statistics/lonproblemstatistics.pm 2002/08/14 16:18:55 1.25 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # (Publication Handler # -# $Id: lonproblemstatistics.pm,v 1.20 2002/08/13 12:21:46 stredwic Exp $ +# $Id: lonproblemstatistics.pm,v 1.25 2002/08/14 16:18:55 stredwic Exp $ # # Copyright Michigan State University Board of Trustees # @@ -52,7 +52,32 @@ sub BuildProblemStatisticsPage { $jr = $r; unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { - return 'Unable to tie database.'; + $r->print('Unable to tie database.'); + return; + } + + # Remove students who don't have the proper section. + my @sectionsSelected = split(':',$cache{'sectionsSelected'}); + for(my $studentIndex=((scalar @$students)-1); $studentIndex>=0; + $studentIndex--) { + my $value = $cache{$students->[$studentIndex].':section'}; + my $found = 0; + foreach (@sectionsSelected) { + if($_ eq 'none') { + if($value eq '' || !defined($value) || $value eq ' ') { + $found = 1; + last; + } + } else { + if($value eq $_) { + $found = 1; + last; + } + } + } + if($found == 0) { + splice(@$students, $studentIndex, 1); + } } my $Ptr = ''; @@ -69,6 +94,14 @@ sub BuildProblemStatisticsPage { 'ProblemStatistics', 'Statistics'); $Ptr .= ''."\n"; + $Ptr .= 'Select Sections'; + $Ptr .= ''."\n"; + $Ptr .= ''."\n"; + my @sections = split(':',$cache{'sectionList'}); + $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections, + \@sectionsSelected, + 'Statistics'); + $Ptr .= ''."\n"; $Ptr .= &ProblemStatisticsButtons($cache{'DisplayFormat'}, $cache{'DisplayLegend'}); $Ptr .= ''; @@ -78,49 +111,122 @@ sub BuildProblemStatisticsPage { $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); + my $lastStatus = (defined($cache{'StatisticsLastStatus'})) ? + $cache{'StatisticsLastStatus'} : 'Nothing'; + my $whichStudents = join(':::',sort(@$students)); + if(!defined($cache{'StatisticsCached'}) || + $lastStatus ne $cache{'Status'} || + $whichStudents ne $cache{'StatisticsWhichStudents'}) { + if(defined($cache{'StatisticsCached'})) { + untie(%cache); + unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) { + $r->print('Unable to tie database.'); + return; + } + my @statkeys = split(':::', $cache{'StatisticsKeys'}); + delete $cache{'StatisticsKeys'}; + delete $cache{'StatisticsCached'}; + foreach(@statkeys) { + delete $cache{$_}; + } + } + 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)) { + $r->print('Unable to tie database.'); + return; + } + my ($problemData) = &ExtractStudentData(\%cache, $students); + &CalculateStatistics($problemData, \%cache); + untie(%cache); + + unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) { + $r->print('Unable to tie database.'); + return; + } + foreach(keys(%$problemData)) { + $cache{$_} = $problemData->{$_}; + } + $cache{'StatisticsKeys'} = join(':::', keys(%$problemData)); + $cache{'StatisticsCached'} = 'true'; + $cache{'StatisticsLastStatus'} = $cache{'Status'}; + $cache{'StatisticsWhichStudents'} = $whichStudents; + untie(%cache); + + unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { + $r->print('Unable to tie database.'); + return; + } + } + + my $orderedProblems = &SortProblems(\%cache, + $cache{'ProblemStatisticsSort'}, + $cache{'ProblemStatisticsAscend'}); + &BuildStatisticsTable(\%cache, $cache{'DisplayFormat'}, $orderedProblems, + \@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); -# } -# } + return; +} + +sub BuildGraphicChart { + my ($graph,$cacheDB,$courseDescription,$r)=@_; + my %cache; + my $max = 0; + + unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { + return 'Unable to tie database.'; + } + + my @problems = split(':::', $cache{'problemList'}); + my @values = (); + foreach (@problems) { + my $data = 0; + if($graph eq 'DoDiffGraph') { + $data = sprintf("%.2f", $cache{$_.':degreeOfDifficulty'}), + } else { + $data = sprintf("%.1f", $cache{$_.':percentWrong'}), + } + if($max < $data) { + $max = $data; + } + push(@values, $data); + } + untie(%cache); -# if($c->aborted()) { return; } -# untie(%cache); + my $sendValues = join(',', @values); + my $sendCount = scalar(@values); + + my $title = ''; + if($graph eq 'DoDiffGraph') { + $title = 'Degree-of-Difficulty'; + } else { + $title = 'Wrong-Percentage'; + } + my @GData = ($courseDescription, 'Problems', $title, $max, $sendCount, + $sendValues); + + $r->print(''."\n"); + $r->print(''); + $r->print('
'."\n"); return; } - #---- Problem Statistics Web Page --------------------------------------- sub CreateProblemStatisticsTableHeading { @@ -141,7 +247,7 @@ sub CreateProblemStatisticsTableHeading } sub BuildStatisticsTable { - my ($cache,$displayFormat,$data,$headings,$r,$color)=@_; + my ($cache,$displayFormat,$orderedProblems,$headings,$r,$color)=@_; #6666666 # my $file="/home/httpd/perl/tmp/183d.txt"; @@ -157,9 +263,7 @@ sub BuildStatisticsTable { ##777777 ## $Str .= &Classify($discriminantFactor, $students); - my %TempCache; - my $problems = $data->{'problemList'}; - if($displayFormat ne 'Display CSV Format') { + if($displayFormat ne 'Display CSV Format') { $r->print('
'."\n"); $r->print(''."\n"); $r->print(&CreateProblemStatisticsTableHeading($headings, $r)); @@ -168,126 +272,50 @@ sub BuildStatisticsTable { } my $count = 1; - foreach(@$problems) { + foreach(@$orderedProblems) { my ($sequence,$problem,$part)=split(':', $_); -# my $problemRef = ''.$cache->{$problem.':title'}.''; + if($cache->{'StatisticsMaps'} ne 'All Maps' && + $cache->{'StatisticsMaps'} ne $cache->{$sequence.':title'}) { + next; + } - my $ref = $cache->{$problem.':title'}; + my $ref = ''.$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; + $cache->{$_.':studentCount'}, + $cache->{$_.':totalTries'}, + $cache->{$_.':maxTries'}, + sprintf("%.2f", $cache->{$_.':mean'}), + $cache->{$_.':correct'}, + $cache->{$_.':correctByOverride'}, + sprintf("%.1f", $cache->{$_.':percentWrong'}), + sprintf("%.2f", $cache->{$_.':degreeOfDifficulty'}), + sprintf("%.1f", $cache->{$_.':standardDeviation'}), + sprintf("%.1f", $cache->{$_.':skewness'}), + sprintf("%.2f", $cache->{$_.':discriminationFactor1'}), + sprintf("%.2f", $cache->{$_.':discriminationFactor2'}), + 0); # 0 is for discussion, need to figure out -#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 +# $r->print('
'.$out.'&'.$DoD); +# print (OUT $out.'@'.$DoD.'&'); +#6666666 + +#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; + return; } -=cut sub TableRow { my ($displayFormat,$Str,$RealIdx,$r,$color)=@_; @@ -454,11 +482,6 @@ sub ExtractStudentData { my @problemList=(); my %problemData; foreach my $sequence (split(':', $cache->{'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. @@ -518,7 +541,33 @@ sub ExtractStudentData { } } - $problemData{'problemList'} = \@problemList; + my @upperStudents1=(); + my @lowerStudents1=(); + my @upperStudents2=(); + my @lowerStudents2=(); + my $upperCount = int(0.27*scalar(@$students)); + # Discriminant Factor criterion 1 + my $sortedStudents = &SortDivideByTries($students,$cache,':totalAwarded'); + + for(my $i=0; $i<$upperCount; $i++) { + push(@lowerStudents1, $sortedStudents->[$i]); + push(@upperStudents1, $sortedStudents->[(scalar(@$students)-$i-1)]); + } + + $problemData{'studentsUpperListCriterion1'}=join(':::', @upperStudents1); + $problemData{'studentsLowerListCriterion1'}=join(':::', @lowerStudents1); + + # Discriminant Factor criterion 2 + $sortedStudents = &SortDivideByTries($students, $cache, ':totalSolved'); + + for(my $i=0; $i<$upperCount; $i++) { + push(@lowerStudents2, $sortedStudents->[$i]); + push(@upperStudents2, $sortedStudents->[(scalar(@$students)-$i-1)]); + } + $problemData{'studentsUpperListCriterion2'}=join(':::', @upperStudents2); + $problemData{'studentsLowerListCriterion2'}=join(':::', @lowerStudents2); + + $problemData{'problemList'} = join(':::', @problemList); # $Discussed=0; # if($Discuss->{"$name:$problem"}) { # $TotDiscuss++; @@ -528,11 +577,24 @@ sub ExtractStudentData { return \%problemData; } +sub SortDivideByTries { + my ($toSort, $data, $sortOn)=@_; + my @orderedData = sort { ($data->{$a.':totalTries'}) ? + ($data->{$a.$sortOn}/$data->{$a.':totalTries'}):0 + <=> + ($data->{$b.':totalTries'}) ? + ($data->{$b.$sortOn}/$data->{$b.':totalTries'}):0 + } @$toSort; + + return \@orderedData; +} + sub SortProblems { my ($problemData,$sortBy,$ascend)=@_; + my @problems = split(':::', $problemData->{'problemList'}); if($sortBy eq "Homework Sets Order") { - return; + return \@problems; } my $data; @@ -550,26 +612,23 @@ sub SortProblems { elsif($sortBy eq "D.F.1st") { $data = ':discriminantFactor1'; } elsif($sortBy eq "D.F.2nd") { $data = ':discriminantFactor2'; } elsif($sortBy eq "Disc.") { $data = ''; } - else { return; } + else { return \@problems; } - my $problems = $problemData->{'problemList'}; my @orderedProblems = sort { $problemData->{$a.$data} <=> $problemData->{$b.$data} } - @$problems; + @problems; if($ascend eq 'Descending') { @orderedProblems = reverse(@orderedProblems); } - $problemData->{'problemList'} = \@orderedProblems; - - return; + return \@orderedProblems; } sub CalculateStatistics { - my ($data)=@_; + my ($data, $cache)=@_; - my $problems = $data->{'problemList'}; - foreach(@$problems) { + my @problems = split(':::', $data->{'problemList'}); + foreach(@problems) { # Mean $data->{$_.':mean'} = ($data->{$_.':studentCount'}) ? ($data->{$_.':totalTries'} / $data->{$_.':studentCount'}) : 0; @@ -610,136 +669,48 @@ sub CalculateStatistics { 0; # Discrimination Factor 1 - $data->{$_.':discriminationFactor1'} = 0; + my ($sequence, $problem, $part) = split(':', $_); - # Discrimination Factor 2 - $data->{$_.':discriminationFactor2'} = 0; - } + my @upper1 = split(':::', $data->{'studentsUpperListCriterion1'}); + my @lower1 = split(':::', $data->{'studentsLowerListCriterion1'}); - 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 $upper1Sum=0; + foreach my $name (@upper1) { + $upper1Sum += $cache->{"$name:$problem:$part:awarded"}; } - } - my %DisUp = &ProcessDiscriminant(\@UpList); - my %DisLow = &ProcessDiscriminant(\@LowList); - - return (\%DisUp, \%DisLow); -} - -#---- END Problem Statistics Web Page ---------------------------------------- + $upper1Sum = (scalar(@upper1)) ? ($upper1Sum/(scalar(@upper1))) : 0; -#---- Problem Statistics Graph Web Page -------------------------------------- + my $lower1Sum=0; + foreach my $name (@lower1) { + $lower1Sum += $cache->{"$name:$problem:$part:awarded"}; + } + $lower1Sum = (scalar(@lower1)) ? ($lower1Sum/(scalar(@lower1))) : 0; -# ------------------------------------------- Prepare data for Graphical chart + $data->{$_.':discriminationFactor1'} = $upper1Sum - $lower1Sum; -sub BuildGraphicChart { - my ($ylab,$r,$cacheDB)=@_; - my %cache; - my $Col; - my $data=''; - my $count = 0; - my $Max = 0; + # Discrimination Factor 2 + my @upper2 = split(':::', $data->{'studentsUpperListCriterion2'}); + my @lower2 = split(':::', $data->{'studentsLowerListCriterion2'}); - unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { - return 'Unable to tie database.'; - } - - my $p_count = $cache{'ProblemCount'}; + my $upper2Sum=0; + foreach my $name (@upper2) { + $upper2Sum += $cache->{"$name:$problem:$part:awarded"}; + } + $upper2Sum = (scalar(@upper2)) ? ($upper2Sum/(scalar(@upper2))) : 0; - 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"); + my $lower2Sum=0; + foreach my $name (@lower2) { + $lower2Sum += $cache->{"$name:$problem:$part:awarded"}; + } + $lower2Sum = (scalar(@lower2)) ? ($lower2Sum/(scalar(@lower2))) : 0; - 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; + $data->{$_.':discriminationFactor2'} = $upper2Sum - $lower2Sum; } - my $Course = $ENV{'course.'.$cid.'.description'}; - $Course =~ s/\ /"_"/eg; - my $GData=$Course.'&'.'Problems#'.'&'.$ylab.'&'. - $Max.'&'.$count.'&'.$data; - - $r->print(''); return; } +#---- END Problem Statistics Web Page ---------------------------------------- + 1; __END__