[BACK]Return to lonstatistics.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonstatistics.pm between versions 1.2 and 1.3

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> &nbsp;&nbsp;&nbsp; ".  
               "Current Section: <b>\"$CurSec\" </b>&nbsp;&nbsp;&nbsp;".  
               "Number of valid students: <b>$Count</b>".  
               "<br>The <b>Upper 27%</b> has <b>$UpCnt</b> records.".  
               "&nbsp;&nbsp;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: &nbsp; </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'}".
Removed from v.1.2  
changed lines
  Added in v.1.3

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>