--- loncom/interface/lonstatistics.pm 2002/02/05 12:24:45 1.2
+++ loncom/interface/lonstatistics.pm 2002/07/17 12:53:00 1.27
@@ -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.27 2002/07/17 12:53:00 stredwic Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -27,834 +27,578 @@
#
# (Navigate problems for statistical reports
# YEAR=2001
-# 5/05/01, 7/09/01, 7/25/01, 8/11/01,9/13/01, 9/26/01 Behrouz Minaei
-# 10/5/01, 10/9/01, 10/22/01, 10/26/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
+# 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/02,2/1/02
+# 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 Behrouz Minaei
+#
###
-package Apache::lonstatistics;
+package Apache::lonstatistics;
-use strict;
+use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet();
use Apache::lonhomework;
+use Apache::loncommon;
+use Apache::loncoursedata;
use HTML::TokeParser;
use GDBM_File;
-use Benchmark;
# -------------------------------------------------------------- Module Globals
my %hash;
my %CachData;
my %GraphDat;
-my %maps;
-my @mapsort;
-my %section;
-my %StuBox;
-my %DiscFac;
-my $CurMap;
-my $CurSec;
-my $CurStu;
-my @cols;
-my @list;
-my @students;
-my $p_count;
+my %mapsort;
my $Pos;
my $r;
-my $OpSel1;
-my $OpSel2;
-my $OpSelDis1;
-my $OpSelDis2;
-my $CurDis=0;
-my $OpSel3;
-my $OpSel4;
my $GData;
-my $cid;
-my $firstres;
-my $lastres;
-my $DiscFlag=0;
-my $HWN=0;
-
-my %Header = (0,"Problem Title",1,"#Stdnts",2,"Tries",3,"Mod",
- 4,"Mean",5,"#YES",6,"#yes",7,"%Wrng",8,"S.D.",
- 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 %color;
+my %foil_to_concept;
+my @Concepts;
+my %ConceptData;
+my %Answer = ();
+
+sub Activity {
+ my $file="/home/minaeibi/activity.log";
+ my $userid='adamsde1';
+ $r->print(" Using $file");
+ $r->rflush();
+ open(FILEID, "<$file");
+ my $line;
+ my @allaccess;
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;
+ while ($line=) {
+ my ($time,$machine,$what)=split(':',$line);
+ $what=&Apache::lonnet::unescape($what);
+ my @accesses=split('&',$what);
+ foreach my $access (@accesses) {
+ my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
+ if ($who ne $userid) { next; }
+ if (!$resource) { next; }
+ my $res=&Apache::lonnet::unescape($resource);
+ if (($res =~ /\.(problem|htm|html)/)) {
+ $Count++;
+ $r->print(" $Count) ".localtime($date).": $who --> $res");
+# if ($post) {
+# $Count++;
+# $r->print(" $Count) Sent data ".join(':',
+# &Apache::lonnet::unescape(@posts)).'');
+# }
+ $r->rflush();
+ }
+ ## push (@allaccess,unescape($access));
+ #print $machine;
+ }
}
- return %Proc;
+# @allaccess=sort(@allaccess);
+# $Count=0;
+# foreach my $access (@allaccess) {
+# my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access);
+# $Count++;
+# $r->print(" $Count) $date: $who --> $resource");
+# $r->rflush();
+# if ($post) {
+# $r->print(" Sent data ".join(':',unescape(@posts)).'');
+# }
+# }
}
-sub NumericSort {
- $a <=> $b;
-}
+#---- Analyze Web Page ---------------------------------------------------
+sub InitAnalysis {
+ my ($uri,$part,$problem,$student,$courseID)=@_;
+ my ($username,$userdomain)=split(/\:/,$student);
+
+ # Render the student's view of the problem. $Answ is the problem
+ # Stringafied
+ my $Answ=&Apache::lonnet::ssi($uri,('grade_target' => 'analyze',
+ 'grade_username' => $username,
+ 'grade_domain' => $userdomain,
+ 'grade_courseid' => $courseID,
+ 'grade_symb' => $problem));
+# my $Answ=&Apache::lonnet::ssi($uri,('grade_target' => 'analyze'));
+
+# (undef,$Answ)=split(/_HASH_REF__/,$Answ,2);
+ %Answer=();
+ %Answer=&Apache::lonnet::str2hash($Answ);
-#------- Classification
-sub Classify {
- my $Count=0;
- my @List=();
-# foreach(keys %class){
-# $r->print(" $_ --> $class{$_}");
+# foreach (sort(keys(%Answer))) {
+# $r->print($_.' '.$Answer{$_}.' ');
# }
- # $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]}));
- }
+
+ my $parts='';
+ foreach my $elm (@{$Answer{"parts"}}) {
+ $parts.="$elm,";
+ }
+ chop($parts);
+ my $conc='';
+ foreach my $elm (@{$Answer{"$parts.concepts"}}) {
+ $conc.="$elm@";
+ }
+ chop($conc);
+
+ @Concepts=split(/\@/,$conc);
+ foreach my $concept (@{$Answer{"$parts.concepts"}}) {
+ foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
+ $foil_to_concept{$foil} = $concept;
+ #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
}
}
-
- $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{$_}");
- # }
+ return;
}
-#------- 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;
+sub Interval {
+ my ($part,$symb)=@_;
+ my $interval=$ConceptData{"Interval"};
+ my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb)+1;
+ my $open = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb);
+ my $add=int(($due-$open)/$interval);
+ $ConceptData{'Interval.0'}=$open;
+ for (my $i=1;$i<$interval;$i++) {
+ $ConceptData{'Interval.'.$i}=$open+$i*$add;
+ }
+ $ConceptData{'Interval.'.$interval}=$due;
+ for (my $i=0;$i<$interval;$i++) {
+ for (my $n=0; $n<=$#Concepts; $n++ ) {
+ my $tmp=$Concepts[$n];
+ $ConceptData{$tmp.'.'.$i.'.true'}=0;
+ $ConceptData{$tmp.'.'.$i.'.false'}=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,$_);}
- }
- }
- }
- }
+sub ShowOpGraph {
+ my ($cache, $students, $courseID)=@_;
+ my $uri = $cache->{'AnalyzeURI'};
+ my $part = $cache->{'AnalyzePart'};
+ my $problem = $cache->{'AnalyzeProblem'};
+ my $title = $cache->{'AnalyzeProblem'};
+ my $interval = $cache->{'Interval'};
+ $ConceptData{"Interval"} = $interval;
- my %Up=&ProcessDisc(@UpList);
- my %Low=&ProcessDisc(@LowList);
+ #Initialize the option response true answers
+ &InitAnalysis($uri, $part, $problem, $students->[0],$courseID);
- my @list = ();
- my $Useful;
- my $UnUseful;
- $p_count = 0;
+ #compute the intervals
+ &Interval($part,$problem);
- foreach my $key( keys %CachData) {
- my @Temp=split(/\:/,$CachData{$key});
- ($UnUseful,$Useful)=split(/\>/,$Temp[0]);
- $list[$p_count]=$Useful.'&'.$CachData{$key};
- $p_count++;
+ $title =~ s/\ /"_"/eg;
+ $r->print(' '.$uri.'');
+ $r->rflush();
+
+ #Java script Progress window
+ &Create_PrgWin();
+ &Update_PrgWin("Starting to analyze problem",0,0,'');
+ for(my $index=0; $index<(scalar @$students); $index++) {
+ &Update_PrgWin(scalar @$students, $index+1, $students->[$index]);
+ &OpStatus($problem, $students->[$index], $courseID);
+ }
+ &Close_PrgWin();
+
+ $r->print(' ');
+ for(my $k=0; $k<$interval; $k++ ) {
+ &DrawGraph($k,$title);
+ }
+ for(my $k=0; $k<$interval; $k++ ) {
+ &DrawTable($k);
+ }
+#$Apache::lonxml::debug=1;
+#&Apache::lonhomework::showhash(%ConceptData);
+#$Apache::lonxml::debug=0;
+ my $Answ=&Apache::lonnet::ssi($uri);
+ $r->print(" Here you can see the Problem: $Answ");
+}
+
+sub DrawTable {
+ my $k=shift;
+ my $Max=0;
+ my @data1;
+ my @data2;
+ my $Correct=0;
+ my $Wrong=0;
+ for (my $n=0; $n<=$#Concepts; $n++ ) {
+ my $tmp=$Concepts[$n];
+ $data1[$n]=$ConceptData{"$tmp.$k.true"};
+ $Correct+=$data1[$n];
+ $data2[$n]=$ConceptData{"$tmp.$k.false"};
+ $Wrong+=$data2[$n];
+ my $Sum=$data1[$n]+$data2[$n];
+ if ( $Max<$Sum ) {$Max=$Sum;}
+ }
+ for (my $n=0; $n<=$#Concepts; $n++ ) {
+ if ($data1[$n]+$data2[$n]<$Max) {
+ $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
+ }
}
+ my $P_No = $#data1+1;
+# $r->print(' From: ['.localtime($ConceptData{'Int.'.($k-1)}).
+# '] To: ['.localtime($ConceptData{"Int.$k"}).']');
+ my $Str = "\n".'
From:['.localtime($ConceptData{'Int.'.$k}).
+ '] To: ['.localtime($ConceptData{'Int.'.($k+1)}-1).
+ "]
$Correct
$Wrong
";
- my $Result = "\n".'
';
- $Result .= "\n".'
P#
';
- $Result .= "\n".'
'.$Header{0}.'
';
- $Result .= "\n".'
'.'Discrimination Factor'.'
';
- $Result .= "\n".'
'.'%Upper Award'.'
';
- $Result .= "\n".'
'.'%Lower Award'.'
';
- $Result .= "\n".'
'.'Upper Records'.'
';
- $Result .= "\n".'
'.'Lower Records'.'
';
- $Result .= "\n".'
'.'%Degree of Difficulty'.'
';
- $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".'
'.($nIdx+1).'
'.
- "\n".'
'.$Temp.'
'.
- "\n".'
'.$_Dis.'
'.
- "\n".'
'.$U_Dis.'
'.
- "\n".'
'.$L_Dis.'
'.
- "\n".'
'.$UpNo.'
'.
- "\n".'
'.$LwNo.'
'.
- "\n".'
'.$DoD.'
'.
- "\n".'
' );
- }
- $r->print("\n".'
');
- $r->rflush();
+ $Str .= "\n".'
';
+
+ $r->print($Str);
+#$Apache::lonxml::debug=1;
+#&Apache::lonhomework::showhash(%ConceptData);
+#$Apache::lonxml::debug=0;
}
-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();
+sub DrawGraph {
+ my ($currentInterval,$title)=@_;
+ my $Max=0;
+ my @data1;
+ my @data2;
+
+ # Adjust Data and find the Max
+ for(my $n=0; $n<=$#Concepts; $n++ ) {
+ my $tmp=$Concepts[$n];
+ $data1[$n]=$ConceptData{$tmp.'.'.$currentInterval.'.true'};
+ $data2[$n]=$ConceptData{$tmp.'.'.$currentInterval.'.false'};
+ my $Sum=$data1[$n]+$data2[$n];
+ if($Max < $Sum) { $Max = $Sum; }
+ }
+ for(my $n=0; $n<=$#Concepts; $n++) {
+ if($data1[$n]+$data2[$n]<$Max) {
+ $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
}
- else {$r->print("Unable to tie hash to db file");}
}
- untie(%CachData);
- untie(%DiscFac);
-}
+ my $P_No = scalar @data1;
+ if($Max > 1) {
+ $Max += (10 - $Max % 10);
+ $Max = int($Max);
+ } else {
+ $Max = 1;
+ }
+
+ my $Titr=($ConceptData{'Interval'}>1) ?
+ $title.'_interval_'.($currentInterval+1) : $title;
+# $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
+ $GData = $Titr.'&Concepts&Answers&'.$Max.'&'.$P_No.'&';
+ $GData .= (join(',',@data1)).'&'.(join(',',@data2));
+
+ $r->print('');
+}
-# ------ Create different Student Report
-sub StudentReport {
- my ($sname,$sdom)=@_;
- if ( $sname eq 'All Students' ) {
- $r->print( '
WARNING:
- Please select a student
' );
- return;
- }
- my $shome=&Apache::lonnet::homeserver( $sname,$sdom );
- my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$cid,$shome );
- my %result = ();
- my $ResId;
- my $Code;
- my $Tries;
- my $TotalTries = 0;
- my $ParCr = 0;
- my $Wrongs;
- my %TempHash;
- my $Version;
- my $LatestVersion;
- my $PtrTry='';
- my $PtrCod='';
- my $SetNo=0;
- my $Str = "\n".'
";
- }
- $PtrTry='';
- $PtrCod='';
- next;
- }
- $ResId=~/(\d+)\.(\d+)/;
- my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
- if ( $CurMap ne 'All Maps' ) {
- my ( $ResMap, $NameMap ) = split(/\=/,$CurMap);
- if ( $Map ne $ResMap ) { next; }
- }
- my $meta=$hash{'src_'.$ResId};
- my $PartNo = 0;
- undef %TempHash;
- map {
- if ($_=~/^stores\_(\d+)\_tries$/) {
- my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
- if ( $TempHash{"$Part"} eq '' ) {
- $TempHash{"$Part"} = $Part;
- $TempHash{$PartNo}=$Part;
- $TempHash{"$Part.Code"} = '-';
- $PartNo++;
- }
- }
- } split(/\,/,&Apache::lonnet::metadata($meta,'keys'));
- my $Prob = $Map.'___'.$2.'___'.
- &Apache::lonnet::declutter( $hash{'src_'.$ResId} );
- $Code='U';
- $Tries = 0;
- $Wrongs = 0;
- $LatestVersion = $result{"version:$Prob"};
-
- if ( $LatestVersion ) {
- for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
- my $vkeys = $result{"$Version:keys:$Prob"};
- my @keys = split(/\:/,$vkeys);
-
- foreach my $Key (@keys) {
- if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
- my $Part = $1;
- $Tries = $result{"$Version:$Prob:resource.$Part.tries"};
- $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0;
- $TotalTries += $Tries;
- my $Val = $result{"$Version:$Prob:resource.$Part.solved"};
- if ( $Val eq 'correct_by_student' )
- { $Wrongs = $Tries - 1; $Code = 'Y'; }
- elsif ( $Val eq 'correct_by_override' )
- { $Wrongs = $Tries - 1; $Code = 'y'; }
- elsif ( $Val eq 'incorrect_attempted' ||
- $Val eq 'incorrect_by_override' )
- { $Wrongs = $Tries; $Code = 'N'; }
- $TempHash{"$Part.Code"} = $Code;
- $TempHash{"$Part.Wrongs"} = $Wrongs;
+sub Decide {
+ #deciding the true or false answer belongs to each interval
+ my ($type,$foil,$time)=@_;
+ my $k=0;
+ while ($time>$ConceptData{'Int.'.($k+1)} &&
+ $k<$ConceptData{'Interval'}) {$k++;}
+ $ConceptData{"$foil_to_concept{$foil}.$k.$type"}++;
+}
+
+
+#restore the student submissions and finding the result
+sub OpStatus {
+ my ($problem, $student, $courseID)=@_;
+ my ($username,$userdomain)=split(/':'/,$student);
+ my $code='U';
+ my %reshash=&Apache::lonnet::restore($problem, $courseID, $userdomain,
+ $username);
+ my @True = ();
+ my @False = ();
+ my $flag=0;
+ if ($reshash{'version'}) {
+ my $tries=0;
+ &Apache::lonhomework::showhash(%Answer);
+ for (my $version=1;$version<=$reshash{'version'};$version++) {
+ my $time=$reshash{"$version:timestamp"};
+
+ foreach my $key (sort(split(/\:/,$reshash{$version.':keys'}))) {
+ if (($key=~/\.(\w+)\.(\w+)\.submission$/)) {
+ my $Id1 = $1; my $Id2 = $2;
+ #check if this is a repeat submission, if so skip it
+ if ($reshash{"$version:resource.$Id1.previous"}) { next; }
+ #if no solved this wasn't a real submission, ignore it
+ if (!defined($reshash{"$version:resource.$Id1.solved"})) {
+ &Apache::lonxml::debug("skipping ");
+ next;
+ }
+ my $Resp = $reshash{"$version:$key"};
+ my %submission=&Apache::lonnet::str2hash($Resp);
+ foreach (keys %submission) {
+ my $Ansr = $Answer{"$Id1.$Id2.foil.value.$_"};
+ if ($submission{$_}) {
+ if ($submission{$_} eq $Ansr) {
+ &Decide("true",$_,$time );
+ }
+ else {&Decide("false",$_,$time );}
}
- }
- }
- for ( my $n = 0; $n < $PartNo; $n++ ) {
- my $part = $TempHash{$n};
- if ($PtrTry ne '') {$PtrTry .= ',';}
- $PtrTry .= "$TempHash{$part.'.Tries'}";
- $PtrCod .= "$TempHash{$part.'.Code'}";
- }
- }
- else {
- for(my $n=0; $n<$PartNo; $n++) {
- if ($PtrTry ne '') {$PtrTry .= ',';}
- $PtrTry .= "0";
- $PtrCod .= "-";
- }
+ }
+ }
}
}
}
- $Str .= "\n".'
';
- $r->print($Str);
- $r->rflush();
}
+#---- END Analyze Web Page ----------------------------------------------
+#---- Problem Statistics Web Page ---------------------------------------
+#------- Processing upperlist and lowerlist according to each problem
+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) {
+ ($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).':'.$nStudent;
+ $Proc{$Temp}=($Sum1/$nStudent).':'.($Sum2/$nStudent);
+# $r->print("$nIndex) $Temp --> ($nStudent) $Proc{$Temp} ");
+ $Sum1=0;
+ $Sum2=0;
+ $nStudent=0;
+ }
-# ------------------------------------------- Prepare Statistics Table
-sub PreStatTable {
- my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
- "_$ENV{'user.domain'}_$cid\_statistics.db";
- my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
- "_$ENV{'user.domain'}_$cid\_graph.db";
- my $CachDisFac = "/home/httpd/perl/tmp/$ENV{'user.name'}".
- "_$ENV{'user.domain'}_$cid\_DiscFactor.db";
- $r->print(' ');
-
- my $Ptr = '';
+ return %Proc;
+}
- $Ptr .= ' Sorting Type: '."\n".
- ' '."\n";
- $Ptr .= ' ';
- $Ptr .= ''."\n";
- $Ptr .= ' ';
- $Ptr .= ''."\n";
- $Ptr .= '
'.
- ' #Stdnts: Total Number of Students opened the problem. '.
- ' Tries : Total Number of Tries for solving the problem. '.
- ' Mod : Maximunm Number of Tries for solving the problem. '.
- ' Mean : Average Number of the tries. [ Tries / #Stdns ] '.
- ' #YES : Number of students solved the problem correctly. '.
- ' #yes : Number of students solved the problem by override. '.
- ' %Wrng : Percentage of students tried to solve the problem but'.
- ' still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ] '.
- ' S.D. : Standard Deviation of the tries.'.
- '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1)'.
- ' where Xi is every student\'s tries ] '.
- ' Skew. : Skewness of the students tries.'.
- ' [ (sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3) ] '.
-# ' DoDiff : Degree of Difficulty of the problem. [ Tries/(#YES+#yes+0.1) ] '.
- ' DoDiff : Degree of Difficulty of the problem. [ 1 - ((#YES+#yes) / Tries) ] '.
-# ' Dis.F. : Discrimination Factor. [ Sum of Partial Credits Awarded / Total Number of Tries in %27 upper and lower students]'.
- '
';
+#------- Creating Discimination factor
+sub Discriminant {
+ my ($discriminantFactor)=@_;
+ my @discriminantKeys=keys(%$discriminantFactor);
+ my $Count = scalar @discriminantKeys;
- $r->print($Ptr);
- $r->rflush();
-
- my $Result = "\n".'
';
- $Result .= '
P#
'."\n";
- for ( my $nIdx=0; $nIdx < 12; $nIdx++ ) {
- $Result .= '
'.''.'
'."\n";
- }
- $Result .= "\n".'
'."\n";
- $r->print( $Result );
- $r->rflush();
+ my $UpCnt = int(0.27*$Count);
+ my $low=0;
+ my $up=$Count-$UpCnt;
+ my @UpList=();
+ my @LowList=();
- if ((-e "$CacheDB")&&($ENV{'form.sort'} ne 'Recalculate Statistics')) {
- if (tie(%CachData,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) {
- tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640);
- &Cache_Statistics();
- }
- 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);
- tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640);
- foreach (keys %DiscFac) {delete $CachData{$_};}
- foreach (keys %CachData) {delete $CachData{$_};}
- $DiscFlag=0;
- &Build_Statistics();
- }
- else {
- $r->print("Unable to tie hash to db file");
+ $Count=0;
+ foreach my $key (sort(@discriminantKeys)) {
+ $Count++;
+ if($low < $UpCnt || $Count > $up) {
+ $low++;
+ my $str=$discriminantFactor->{$key};
+ foreach(split(/\:/,$str)){
+ if($_) {
+ if($low<$UpCnt) { push(@LowList,$_); }
+ else { push(@UpList,$_); }
+ }
+ }
}
}
- #$r->print('Total instances of the problems : '.($p_count*($#students+1)));
+ my %DisUp = &ProcessDiscriminant(\@UpList);
+ my %DisLow = &ProcessDiscriminant(\@LowList);
- untie(%CachData);
- untie(%GraphDat);
- untie(%DiscFac);
+ return (\%DisUp, \%DisLow);
+}
- $r->print("\n".'
'."\n");
- $r->rflush();
+sub NumericSort {
+ $a <=> $b;
}
+sub CreateProblemStatisticsTableHeading {
+ my ($displayFormat,$sequenceSource,$sequenceTitle,$headings)=@_;
+ if($displayFormat eq 'Display CSV Format') {
+ $r->print(' "'.$sequenceTitle.'","');
+ $r->print($sequenceSource.'"');
+ return;
+ }
-# ------------------------------------- Find the section of student in a course
+ $r->print(' '.$sequenceTitle.'');
-sub usection {
- my ($udom,$unam,$courseid)=@_;
- $courseid=~s/\_/\//g;
- $courseid=~s/^(\w)/\/$1/;
- map {
- my ($key,$value)=split(/\=/,$_);
- $key=&Apache::lonnet::unescape($key);
- if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
- my $section=$1;
- if ($key eq $courseid.'_st') { $section=''; }
- my ($dummy,$end,$start)=split(/\_/,&Apache::lonnet::unescape($value));
- $section=($section) ? $section : '(none)';
- $section=(int($section)) ? int($section) : $section;
-# $r->print($unam.'...'.$section.' ');
- return $section;
- }
- } split(/\&/,&Apache::lonnet::reply('dump:'.$udom.':'.$unam.':roles',
- &Apache::lonnet::homeserver($unam,$udom)));
- return '';
+ my $Result = "\n".'
Total Number of Students opened the problem.';
+ $Ptr .= '
';
+ $Ptr .= 'Tries:
';
+ $Ptr .= '
Total Number of Tries for solving the problem.';
+ $Ptr .= '
';
+ $Ptr .= 'Mod:
';
+ $Ptr .= '
Maximunm Number of Tries for solving the problem.';
+ $Ptr .= '
';
+ $Ptr .= 'Mean:
';
+ $Ptr .= '
Average Number of the tries. [ Tries / #Stdnts ]';
+ $Ptr .= '
';
+ $Ptr .= '#YES:
';
+ $Ptr .= '
Number of students solved the problem correctly.';
+ $Ptr .= '
';
+ $Ptr .= '#yes:
';
+ $Ptr .= '
Number of students solved the problem by override.';
+ $Ptr .= '
';
+ $Ptr .= '%Wrng:
';
+ $Ptr .= '
Percentage of students tried to solve the problem ';
+ $Ptr .= 'but still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]';
+ $Ptr .= '
';
+# Kashy formula
+# ' DoDiff : Degree of Difficulty of the problem. '.
+# '[ Tries/(#YES+#yes+0.1) ] '.
+ #Gerd formula
+ $Ptr .= 'DoDiff:
';
+ $Ptr .= '
Degree of Difficulty of the problem. ';
+ $Ptr .= '[ 1 - ((#YES+#yes) / Tries) ]';
+ $Ptr .= '
';
+ $Ptr .= 'S.D.:
';
+ $Ptr .= '
Standard Deviation of the tries. ';
+ $Ptr .= '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) ';
+ $Ptr .= 'where Xi denotes every student\'s tries ]';
+ $Ptr .= '
';
+ $Ptr .= 'Skew.:
';
+ $Ptr .= '
Skewness of the students tries.';
+ $Ptr .= '[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]';
+ $Ptr .= '
';
+ $Ptr .= 'Dis.F.:
';
+ $Ptr .= '
Discrimination Factor: A Standard for evaluating the ';
+ $Ptr .= 'problem according to a Criterion ';
+ $Ptr .= '[Applied Criterion in %27 Upper Students - ';
+ $Ptr .= 'Applied the same Criterion in %27 Lower Students] ';
+ $Ptr .= '1st Criterion for Sorting the Students: ';
+ $Ptr .= 'Sum of Partial Credit Awarded / Total Number of Tries ';
+ $Ptr .= '2nd Criterion for Sorting the Students: ';
+ $Ptr .= 'Total number of Correct Answers / Total Number of Tries';
+ $Ptr .= '
';
+
+ return $Ptr;
+}
+
+#---- END Problem Statistics Web Page ----------------------------------------
+
+#---- Problem Statistics Graph Web Page --------------------------------------
sub GetGraphData {
- my $Tag = shift;
- my $Col;
+ my ($whichGraph, $courseID)=@_;
+ my $Col=0;
+ my $graphTitle='';
my $data='';
my $count = 0;
my $Max = 0;
- my $cid=$ENV{'request.course.id'};
+ my $graphData='Graph data does not exist.';
my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
- "_$ENV{'user.domain'}_$cid\_graph.db";
- foreach (keys %GraphDat) {delete $GraphDat{$_};}
- if (-e "$GraphDB") {
- if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) {
- if ( $Tag eq 'DoDiff Graph' ) {
- $Tag = 'Degree-of-Difficulty';
+ "_$ENV{'user.domain'}_$courseID\_graph.db";
+ if(-e $GraphDB) {
+ if(tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) {
+ if($whichGraph eq 'DiffGraph') {
+ $graphTitle = 'Degree-of-Difficulty';
$Col = 0;
- }
- else {
- $Tag = 'Wrong-Percentage';
+ } else {
+ $graphTitle = 'Wrong-Percentage';
$Col = 1;
}
foreach (sort NumericSort keys %GraphDat) {
my @Temp=split(/\:/,$GraphDat{$_});
my $inf = $Temp[$Col];
- if ( $Max < $inf ) {$Max = $inf;}
+ if($Max < $inf) {
+ $Max = $inf;
+ }
$data .= $inf.',';
$count++;
}
+ if($Max > 1) {
+ $Max += (10 - $Max % 10);
+ $Max = int($Max);
+ } else {
+ $Max = 1;
+ }
untie(%GraphDat);
- my $Course = $ENV{'course.'.$cid.'.description'};
+ my $Course = $ENV{'course.'.$courseID.'.description'};
$Course =~ s/\ /"_"/eg;
- $GData=$Course.'&'.$Tag.'&'.$Max.'&'.$count.'&'.$data;
-
- }
- else {
- $r->print("Unable to tie hash to db file");
+ $graphData = $Course.'&'.'Problems'.'&'.$graphTitle.'&'.$Max.'&';
+ $graphData .= $count.'&'.$data;
+ } else {
+ $graphData = "Unable to tie hash to db file";
}
}
+
+ return $graphData;
}
+#---- END Problem Statistics Graph Web Page ----------------------------------
-sub initial {
-# --------------------------------- Initialize the global varaibles
- undef @students;
- undef @cols;
- undef %maps;
- undef %section;
- undef %StuBox;
- undef @list;
- undef %CachData;
- undef %GraphDat;
- undef %DiscFac;
- undef $CurMap;
- undef $CurSec;
- undef $CurStu;
- undef $p_count;
- undef $Pos;
- undef $GData;
+#---- Problem Analysis Web Page ----------------------------------------------
+
+sub IntervalOptions {
+ my ($cache)=@_;
+
+ my $interval = 1;
+ for(my $n=1; $n<=7; $n++) {
+ if($cache->{'Interval'} == $n) {
+ $interval = $n;
+ }
+ }
+
+ my $Ptr = ' Select number of intervals'."\n".
+ ''."\n";
+
+ return $Ptr;
}
+sub OptionResponseTable {
+ my ($cache)=@_;
+ my $Str = '';
+ $Str .= ' Option Response Problems in this course:'."\n";
+ $Str .= '
'."\n";
+ $Str .= "
\#
Problem Title
";
+ $Str .= '
Resource
Analysis
'."\n";
+
+ my $number=1;
+ foreach (split(':::',$cache->{'OptionResponses'})) {
+ my ($uri,$title,$part,$problem)=split('::',$_);
+ my $Temp = ''.$title.'';
+ $Str .= '
';
+ $Str .= '
'.$number.'
';
+ $Str .= '
'.$Temp.'
';
+ $Str .= '
'.$uri.'
';
+ $Str .= '
'."\n";
+ $number++;
+ }
+ $Str .= '
'."\n";
+
+ return $Str;
+}
+
+#---- END Problem Analysis Web Page ------------------------------------------
+
+#---- Student Assessment Web Page --------------------------------------------
+
+sub MapOptions {
+ my ($cache, $page)=@_;
+ my $Ptr = '
';
+ $Ptr .= '
Select Map
'."\n";
+ $Ptr .= '
'."\n";
+ return $Ptr;
+}
+
+sub StudentOptions {
+ my ($students, $selectedName)=@_;
+
+ my $Ptr ='