--- loncom/interface/lonstatistics.pm 2002/02/05 12:24:45 1.2 +++ loncom/interface/lonstatistics.pm 2002/02/06 16:38:04 1.3 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # (Publication Handler # -# $Id: lonstatistics.pm,v 1.2 2002/02/05 12:24:45 minaeibi Exp $ +# $Id: lonstatistics.pm,v 1.3 2002/02/06 16:38:04 minaeibi Exp $ # # Copyright Michigan State University Board of Trustees # @@ -32,10 +32,10 @@ # 11/1/01, 11/4/01, 11/16/01 Behrouz Minaei # 12/14/01, 12/16/01, 12/18/01,12/20/01,12/31/01 Behrouz Minaei # YEAR=2002 -# 1/22/02,2/1/02 +# 1/22/02,2/1/02 Behrouz Minaei ### -package Apache::lonstatistics; +package Apache::lonstatistics; use strict; use Apache::Constants qw(:common :http); @@ -43,7 +43,7 @@ use Apache::lonnet(); use Apache::lonhomework; use HTML::TokeParser; use GDBM_File; -use Benchmark; +#use Benchmark; # -------------------------------------------------------------- Module Globals my %hash; @@ -82,346 +82,10 @@ my %Header = (0,"Problem Title",1,"#Stdn 9,"Skew.",10,"DoDiff",11,"Map"); # 9,"Skew.",10,"DoDiff",11,"Dis.F.",12,"Resourse URL"); -my %class = qw( -); - -my @LS; -my @LF; - -sub GetBin { - my ($Index1,$Index2,$String,$C)=@_; - my @step = 5; - my @L=($C eq 'S') ? @LS : @LF; - my $Count=$#L+1; - $r->print("
zone $C ------ $String "); - for(my $n=0;$n<$Count;$n++){ - my @t=split(/\:/,$L[$n]); - $r->print("
$t[$Index1] $t[$Index2]"); - } -} - -sub GetUniqe { - my ($Index,$String,$C)=@_; - my @step = 5; - my @L=($C eq 'S') ? @LS : @LF; - my $Count=$#L+1; - my @List=(); - for(my $n=0;$n<$Count;$n++){ - my @t=split(/\:/,$L[$n]); - push(@List,$t[$Index]); - #$r->print("
$t[$Index]"); - } - @List = sort NumSort(@List); - - $r->print("
zone $C ------ $String "); - my $nIdx=0; - my $nPrb=0; - my %Proc; - undef %Proc; - while ( $nIdx < $Count ) { - my $Focus=$List[$nIdx]; - my $Temp = $Focus; - do { - $nIdx++; - $nPrb++; - $Focus=$List[$nIdx]; - #$Proc{$name}=$Focus; - } while ( $Focus == $Temp && $nIdx < $Count ); - $r->print("
$Temp --> $nPrb"); - $nPrb=0; - } - return %Proc; -} - -sub GetUniq { - my ($Index,$String)=@_; - my @step = 5; - my $Count=0; - my @List=(); - my @temp=(); - foreach (keys(%DiscFac)){ - $Count++; - my @temp1=split(/\:/,$_); - @temp=($temp1[$Index],@temp1); - push(@List,join(':',@temp)); - } - @List = sort NumericSort(@List); - - $r->print("

zone ($Index) ------ $String ----- / $temp[3]"); - my $nIdx=0; - my $nPrb=0; - my %Proc; - undef %Proc; - while ( $nIdx < $Count ) { - my ($Focus,$Dummy,$name)=split(/\:/,$List[$nIdx]); - my $Temp = $Focus; - $Proc{$name}=$Focus; - do { - $nIdx++; - $nPrb++; - ($Focus,$Dummy,$name)=split(/\:/,$List[$nIdx]); - $Proc{$name}=$Focus; - } while ( $Focus == $Temp && $nIdx < $Count ); - $r->print("
$Temp --> $nPrb"); - $nPrb=0; - } - return %Proc; -} - sub NumericSort { $a <=> $b; } - -#------- Classification -sub Classify { - my $Count=0; - my @List=(); -# foreach(keys %class){ -# $r->print("
$_ --> $class{$_}"); -# } - # $DiscFac{($DisFactor.':'.$sname.':'.$ProbTot.':'.$TotalOpend.':'. - # $TotalTries.':'.$ProbSolved.':'.$time)}=$Dis; - @LS=(); - @LF=(); - my $cf=0; - my $cs=0; - foreach (keys(%DiscFac)){ - my @l=split(/\:/,$_); - if ($class{$l[1]}){ - if( $class{$l[1]} == 4 ) { - $cs++; - push(@LS,('S:'.$l[6].':'.$l[0].':'.$l[5].':'.$l[4].':'.$l[3].':'.$class{$l[1]})); - } - elsif ( $class{$l[1]} < 3 ) { - $cf++; - push(@LF,('F:'.$l[6].':'.$l[0].':'.$l[5].':'.$l[4].':'.$l[3].':'.$class{$l[1]})); - } - } - } - - $r->print("
zone successful"); - for(my $n=0;$n<$cs;$n++){ - $r->print('
'.$LS[$n]); - } - - $r->print("
zone failed"); - for(my $n=0;$n<$cf;$n++){ - $r->print('
'.$LF[$n]); - } - -# my %Disc = &GetUniqe(@List,5,"Discrimination Factor"); -# my %Opnd = &GetUniq(@List,3,"Total Opened"); -# my %Trys = &GetUniq(@Lsit4,"Total Tries"); -# my %Slvd = &GetUniq(5,"Problems Solved"); - - # my (@L, $Index,$String)=@_; - - my %Time = &GetUniqe(1,"Time",'S'); - &GetUniqe(1,"Time",'F'); - &GetUniqe(2,"Discrimination Factor",'S'); - &GetUniqe(2,"Discrimination Factor",'F'); - &GetUniqe(3,"Solved",'S'); - &GetUniqe(3,"Solved",'F'); - &GetUniqe(4,"Tries",'S'); - &GetUniqe(4,"Tries",'F'); - - &GetBin(1,2, " Time ... Discriminat",'S'); - &GetBin(1,2, " Time ... Discriminat",'F'); - &GetBin(1,3, " Time ... Solved",'S'); - &GetBin(1,3, " Time ... Solved",'F'); - &GetBin(1,4, " Time ... Tries",'S'); - &GetBin(1,4, " Time ... Tries",'F'); - &GetBin(2,3, " Discriminant ... Solved",'S'); - &GetBin(2,3, " Discriminant ... Solved",'F'); - &GetBin(2,4, " Discriminant ... Tries",'S'); - &GetBin(2,4, " Discriminant ... Tries",'F'); - &GetBin(3,4, " Solved ... Tries",'S'); - &GetBin(3,4, " solved ... Tries",'F'); -# foreach (keys(%Disc)) { -# $r->print("
: $Disc{$_} --> $Slvd{$_}"); - # } - # $r->print("
..........Discriminant ... Time................"); - ## foreach (keys(%Disc)) { - # $r->print("
$Disc{$_} --> $Time{$_}"); - # } - # $r->print("
..........Time ... Solved......................."); - # foreach (keys(%Disc)) { - # $r->print("
$Disc{$_} --> $Slvd{$_}"); - # } -} - -#------- Processing upperlist and lowerlist according to each problem -sub ProcessDisc { - my @List = @_; - @List = sort (@List); - my $Count = $#List+1; - my $Prb; - my @Dis; - my $Slvd=0; - my $tmp; - my $Sum=0; - my $nIdx=0; - my $nStud=0; - my %Proc; - undef %Proc; - while ($nIdx<$Count) { - ($Prb,$tmp)=split(/\=/,$List[$nIdx]); - @Dis=split(/\+/,$tmp); - my $Temp = $Prb; - do { - $nIdx++; - $nStud++; - $Sum += $Dis[$CurDis]; - ($Prb,$tmp)=split(/\=/,$List[$nIdx]); - @Dis=split(/\+/,$tmp); - } while ( $Prb eq $Temp && $nIdx < $Count ); -# $Proc{$Temp}=$Sum.':'.$nStud; - $Proc{$Temp}=($Sum/$nStud).':'.$nStud; -# $r->print("$nIdx) $Temp --> ($nPrb) $Proc{$Temp}
"); - $Sum=0; - $nStud=0; - } - return %Proc; -} - -#------- Creating Discimination factor table -sub DiscriminationTable { - my $Count=0; - foreach (keys(%DiscFac)){ - $Count++; - } - my $UpCnt = int(0.27*$Count); - $r->print("

". - "Current map: \"$CurMap\"     ". - "Current Section: \"$CurSec\"    ". - "Number of valid students: $Count". - "
The Upper 27% has $UpCnt records.". - "  The Lower 27% has $UpCnt records
". - "The Criterion of sorting the students: ". - "( Sum of Partial Credits Awarded / ". - "Total Number of Tries )". - "

"); - $r->rflush(); - my $low=0; - my $up=$Count-$UpCnt; - my @UpList=(); - my @LowList=(); - $Count=0; - foreach my $key (sort(keys(%DiscFac))){ - $Count++; -# $r->print("$Count) $key
"); - - if ($low < $UpCnt || $Count > $up) { - $low++; - my $str=$DiscFac{$key}; -# $r->print("$Count) $str
"); - foreach(split(/\:/,$str)){ - if ($_) { - if ($low<$UpCnt){push(@LowList,$_);} - else {push(@UpList,$_);} - } - } - } - } - - my %Up=&ProcessDisc(@UpList); - my %Low=&ProcessDisc(@LowList); - - my @list = (); - my $Useful; - my $UnUseful; - $p_count = 0; - - foreach my $key( keys %CachData) { - my @Temp=split(/\:/,$CachData{$key}); - ($UnUseful,$Useful)=split(/\>/,$Temp[0]); - $list[$p_count]=$Useful.'&'.$CachData{$key}; - $p_count++; - } - - @list = sort MySort (@list); - - my $Result = "\n".''; - $Result .= "\n".''; - $Result .= "\n".''; - $Result .= "\n".''; - $Result .= "\n".''; - $Result .= "\n".''; - $Result .= "\n".''; - $Result .= "\n".''; - $Result .= "\n".''; - $Result .= "\n".''; - $r->print( $Result ); - - for ( my $nIdx = 0; $nIdx < $p_count; $nIdx++ ) { - my( $Pre, $Post ) = split(/\&/,$list[$nIdx]); - my ($Temp,$MxTries,$StdNo,$TotalTries,$YES,$Override, - $Wrng,$Avg,$SD,$Sk,$DoD,$res,$Prob)=split(/\:/,$Post); - my ($UpDis,$UpNo)=split(/\:/,$Up{$Prob}); - my ($LwDis,$LwNo)=split(/\:/,$Low{$Prob}); - $UpNo = ($UpNo) ? $UpNo : 0; - $LwNo = ($LwNo) ? $LwNo : 0; - my $U_Dis = sprintf("%.4f", $UpDis)*100; - my $L_Dis = sprintf("%.4f", $LwDis)*100; - my $DisFac = $UpDis - $LwDis; - my $_Dis = sprintf("%.4f", $DisFac)*100; - $r->print( "\n".''. - "\n".''. - "\n".''. - "\n".''. - "\n".''. - "\n".''. - "\n".''. - "\n".''. - "\n".''. - "\n".'' ); - } - $r->print("\n".'
P#'.$Header{0}.''.'Discrimination Factor'.''.'%Upper Award'.''.'%Lower Award'.''.'Upper Records'.''.'Lower Records'.''.'%Degree of Difficulty'.'
'.($nIdx+1).''.$Temp.''.$_Dis.''.$U_Dis.''.$L_Dis.''.$UpNo.''.$LwNo.''.$DoD.'
'); - $r->rflush(); -} - -sub CreateDiscFac { - - my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". - "_$ENV{'user.domain'}_$cid\_statistics.db"; - my $CachDisFac = "/home/httpd/perl/tmp/$ENV{'user.name'}". - "_$ENV{'user.domain'}_$cid\_DiscFactor.db"; - - my $ptr=''; -# $ptr .= '
Discrimination Criterion:   '."\n". -# ' '."\n"; - $ptr .= '
'; - $r->print($ptr); - - if ((-e "$CacheDB")&& - ($ENV{'form.sort'} ne 'Recalculate Discrimintion Factor')) { - if (tie(%CachData,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) { - tie(%DiscFac,'GDBM_File',$CachDisFac,&GDBM_READER,0640); - #&DiscriminationTable(); - &Classify(); - } - else {$r->print("Unable to tie hash to db file");} - } - else { - if (tie(%CachData,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) { - tie(%DiscFac,'GDBM_File',$CachDisFac,&GDBM_WRCREAT,0640); - foreach (keys %CachData) {delete $CachData{$_};} - foreach (keys %DiscFac) {delete $DiscFac{$_};} - $DiscFlag=1; - &Build_Statistics(); - $DiscFlag=0; - &DiscriminationTable(); - } - else {$r->print("Unable to tie hash to db file");} - } - untie(%CachData); - untie(%DiscFac); -} - - # ------ Create different Student Report sub StudentReport { my ($sname,$sdom)=@_; @@ -547,8 +211,6 @@ sub StudentReport { } - - # ------------------------------------------- Prepare Statistics Table sub PreStatTable { my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".