version 1.2, 2002/02/05 12:24:45
|
version 1.3, 2002/02/06 16:38:04
|
Line 32
|
Line 32
|
# 11/1/01, 11/4/01, 11/16/01 Behrouz Minaei |
# 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 |
# 12/14/01, 12/16/01, 12/18/01,12/20/01,12/31/01 Behrouz Minaei |
# YEAR=2002 |
# 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 strict; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
Line 43 use Apache::lonnet();
|
Line 43 use Apache::lonnet();
|
use Apache::lonhomework; |
use Apache::lonhomework; |
use HTML::TokeParser; |
use HTML::TokeParser; |
use GDBM_File; |
use GDBM_File; |
use Benchmark; |
#use Benchmark; |
|
|
# -------------------------------------------------------------- Module Globals |
# -------------------------------------------------------------- Module Globals |
my %hash; |
my %hash; |
Line 82 my %Header = (0,"Problem Title",1,"#Stdn
|
Line 82 my %Header = (0,"Problem Title",1,"#Stdn
|
9,"Skew.",10,"DoDiff",11,"Map"); |
9,"Skew.",10,"DoDiff",11,"Map"); |
# 9,"Skew.",10,"DoDiff",11,"Dis.F.",12,"Resourse URL"); |
# 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("<br>zone $C ------ $String "); |
|
for(my $n=0;$n<$Count;$n++){ |
|
my @t=split(/\:/,$L[$n]); |
|
$r->print("<br>$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("<br>$t[$Index]"); |
|
} |
|
@List = sort NumSort(@List); |
|
|
|
$r->print("<br>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("<br>$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("<br><br>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("<br>$Temp --> $nPrb"); |
|
$nPrb=0; |
|
} |
|
return %Proc; |
|
} |
|
|
|
sub NumericSort { |
sub NumericSort { |
$a <=> $b; |
$a <=> $b; |
} |
} |
|
|
|
|
#------- Classification |
|
sub Classify { |
|
my $Count=0; |
|
my @List=(); |
|
# foreach(keys %class){ |
|
# $r->print("<br>$_ --> $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("<br>zone successful"); |
|
for(my $n=0;$n<$cs;$n++){ |
|
$r->print('<br>'.$LS[$n]); |
|
} |
|
|
|
$r->print("<br>zone failed"); |
|
for(my $n=0;$n<$cf;$n++){ |
|
$r->print('<br>'.$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("<br>: $Disc{$_} --> $Slvd{$_}"); |
|
# } |
|
# $r->print("<br>..........Discriminant ... Time................"); |
|
## foreach (keys(%Disc)) { |
|
# $r->print("<br>$Disc{$_} --> $Time{$_}"); |
|
# } |
|
# $r->print("<br>..........Time ... Solved......................."); |
|
# foreach (keys(%Disc)) { |
|
# $r->print("<br>$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} <br>"); |
|
$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("<br><br>". |
|
"Current map: <b>\"$CurMap\"</b> ". |
|
"Current Section: <b>\"$CurSec\" </b> ". |
|
"Number of valid students: <b>$Count</b>". |
|
"<br>The <b>Upper 27%</b> has <b>$UpCnt</b> records.". |
|
" The <b>Lower 27%</b> has <b>$UpCnt</b> records <br>". |
|
"The Criterion of sorting the students: ". |
|
"<b>( Sum of Partial Credits Awarded / ". |
|
"Total Number of Tries )</b>". |
|
" <br><br>"); |
|
$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 <br>"); |
|
|
|
if ($low < $UpCnt || $Count > $up) { |
|
$low++; |
|
my $str=$DiscFac{$key}; |
|
# $r->print("$Count) $str <br>"); |
|
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".'<table border=2>'; |
|
$Result .= "\n".'<tr><th>P#</th>'; |
|
$Result .= "\n".'<th>'.$Header{0}.'</th>'; |
|
$Result .= "\n".'<th>'.'Discrimination Factor'.'</th>'; |
|
$Result .= "\n".'<th>'.'%Upper Award'.'</th>'; |
|
$Result .= "\n".'<th>'.'%Lower Award'.'</th>'; |
|
$Result .= "\n".'<th>'.'Upper Records'.'</th>'; |
|
$Result .= "\n".'<th>'.'Lower Records'.'</th>'; |
|
$Result .= "\n".'<th>'.'%Degree of Difficulty'.'</th>'; |
|
$Result .= "\n".'</tr>'; |
|
$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".'<tr>'. |
|
"\n".'<td>'.($nIdx+1).'</td>'. |
|
"\n".'<td>'.$Temp.'</td>'. |
|
"\n".'<td>'.$_Dis.'</td>'. |
|
"\n".'<td>'.$U_Dis.'</td>'. |
|
"\n".'<td>'.$L_Dis.'</td>'. |
|
"\n".'<td>'.$UpNo.'</td>'. |
|
"\n".'<td>'.$LwNo.'</td>'. |
|
"\n".'<td>'.$DoD.'</td>'. |
|
"\n".'</tr>' ); |
|
} |
|
$r->print("\n".'</table>'); |
|
$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 .= '<br><b> Discrimination Criterion: </b>'."\n". |
|
# '<select name="DisType"> <option '.$OpSelDis1.'> Total Numebr of Correct Answers </option>'."\n". |
|
# '<option '.$OpSelDis2.'></option>Sum of Partial Awarded Credits / Total Number of Tries </select> '."\n"; |
|
$ptr .= '<br><input type="submit" name="sort" '. |
|
'value="Recalculate Discrimintion Factor" />'; |
|
$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 |
# ------ Create different Student Report |
sub StudentReport { |
sub StudentReport { |
my ($sname,$sdom)=@_; |
my ($sname,$sdom)=@_; |
Line 547 sub StudentReport {
|
Line 211 sub StudentReport {
|
} |
} |
|
|
|
|
|
|
|
|
# ------------------------------------------- Prepare Statistics Table |
# ------------------------------------------- Prepare Statistics Table |
sub PreStatTable { |
sub PreStatTable { |
my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". |
my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". |