loncom/interface/lonstatistics.pm - view

File: [LON-CAPA] / loncom / interface / lonstatistics.pm
Revision 1.18: download - view: text, annotated - select for diffs
Tue May 14 23:17:06 2002 UTC (21 years, 11 months ago) by minaeibi
Branches: MAIN
CVS tags: HEAD

Fixed bugs in option response problem analysis (thanks to Guy)
Showed the results of option leaves in cute tables.

# The LearningOnline Network with CAPA # (Publication Handler # # $Id: lonstatistics.pm,v 1.18 2002/05/14 23:17:06 minaeibi Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # (Navigate problems for statistical reports # YEAR=2001 # 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,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 Behrouz Minaei # ### package Apache::lonstatistics; use strict; use Apache::Constants qw(:common :http); use Apache::lonnet(); use Apache::lonhomework; use Apache::loncommon; use HTML::TokeParser; use GDBM_File; # -------------------------------------------------------------- Module Globals my %hash; my %CachData; my %GraphDat; my %OpResp; my %maps; my %mapsort; my %section; my %StuBox; my %DiscFac; my %DisUp; my %DisLow; my $UpCnt; my $CurMap; my $CurSec; my $CurStu; my @cols; my @list; my @students; my $p_count; my $Pos; my $r; my $OpSel1; my $OpSel2; my $OpSel3; my $OpSel4; my $GData; my $cid; my $firstres; my $lastres; my $DiscFlag; my $HWN; my $P_Order; my %foil_to_concept; my @Concepts; my %ConceptData; my %Header = (0,"Homework Sets Order",1,"#Stdnts",2,"Tries",3,"Mod", 4,"Mean",5,"#YES",6,"#yes",7,"%Wrng",8,"DoDiff", 9,"S.D.",10,"Skew.",11,"D.F.1st",12,"D.F.2nd"); my %Answer = (); sub InitAnalysis { my ($rid, $student)=@_; my ($uname,$udom)=split(/\:/,$student); $rid=~/(\d+)\.(\d+)/; my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'. &Apache::lonnet::declutter($hash{'src_'.$rid}); my $URI = $hash{'src_'.$rid}; my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze', 'grade_username' => $uname, 'grade_domain' => $udom, 'grade_courseid' => $cid, 'grade_symb' => $symb)); # my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze')); (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2); %Answer=(); %Answer=&Apache::lonnet::str2hash($Answ); 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; } } return $symb; } sub Interval { my ($rid,$part,$symb)=@_; my $Int=$ConceptData{"Interval"}; my $due = &Apache::lonnet::EXT('resource.$part.duedate',$symb)+1; my $opn = &Apache::lonnet::EXT('resource.$part.opendate',$symb); my $add=int(($due-$opn)/$Int); $ConceptData{"Int.0"}=$opn; for (my $i=1;$i<$Int;$i++) { $ConceptData{"Int.$i"}=$opn+$i*$add; } $ConceptData{"Int.$Int"}=$due; for (my $i=0;$i<$Int;$i++) { for (my $n=0; $n<=$#Concepts; $n++ ) { my $tmp=$Concepts[$n]; $ConceptData{"$tmp.$i.true"}=0; $ConceptData{"$tmp.$i.false"}=0; } } } sub ShowOpGraph { my ($InpStr, $Int_No)=@_; my ($rid,$part)=split(/\:/,substr($InpStr,8)); $ConceptData{"Interval"}=$Int_No; my $symb=&InitAnalysis($rid,$students[0]); &Interval($rid,$part,$symb); my $URI = $hash{'src_'.$rid}; my $Src = $hash{'title_'.$rid}; $Src =~ s/\ /"_"/eg; $r->print('<br><b>'.$URI.'</b>'); $r->rflush(); &Create_PrgWin(); &Update_PrgWin("Starting to analyze problem"); for (my $index=0;$index<=$#students;$index++) { &Update_PrgWin($index); &OpStatus($rid,$students[$index]); } &Close_PrgWin(); for (my $k=0; $k<$Int_No; $k++ ) { &DrawGraph($k,$Src); } #$Apache::lonxml::debug=1; #&Apache::lonhomework::showhash(%ConceptData); #$Apache::lonxml::debug=0; my $Answ=&Apache::lonnet::ssi($URI); $r->print("<br><b>Here you can see the Problem:</b><br>$Answ"); } sub DrawGraph { my ($k,$Src)=@_; my $Max=0; my @data1; my @data2; my $Correct=0; my $Wrong=0; # Adjust Data and find the Max 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('<br><b>From: ['.localtime($ConceptData{'Int.'.($k-1)}). # '] To: ['.localtime($ConceptData{"Int.$k"}).']</b>'); my $Str = "\n".'<table border=2>'. "\n".'<tr>'. "\n".'<th> # </th>'. "\n".'<th> Concept </th>'. "\n".'<th> Correct </th>'. "\n".'<th> Wrong </th>'. "\n".'</tr>'; for (my $n=0; $n<=$#Concepts; $n++ ) { $Str .= "\n"."<tr>". "\n"."<td>".($n+1)."</td>". "\n"."<td bgcolor=#FFFFDD> ".$Concepts[$n]." </td>". "\n"."<td bgcolor=#DDFFDD> ".$data1[$n]." </td>". "\n"."<td bgcolor=#FFDDDD> ".$data2[$n]." </td>". "\n"."</tr>"; } $Str.='<td></td><td><b>From:['.localtime($ConceptData{'Int.'.($k-1)}). '] To: ['.localtime($ConceptData{"Int.$k"}). "]</b></td><td>$Correct</td><td>$Wrong</td>"; $Str .= "\n".'</table>'; $r->print($Str); if ( $Max > 1 ) { $Max += (10 - $Max % 10); $Max = int($Max); } else { $Max = 1; } if ( $Max > 1 ) { $Max += (10 - $Max % 10); $Max = int($Max); } else { $Max = 1; } my $Titr=($ConceptData{'Interval'}>1) ? $Src.'_interval_'.$k : $Src; # $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2; $GData="$Titr&Concepts&Answers&$Max&$P_No&". (join(',',@data1)).'&'.(join(',',@data2)); $r->print('<br><IMG src="/cgi-bin/graph.gif?'.$GData.'" />'); } sub AnalyzeProblem { # -------------------------------- Selecting the number of intervals my $OpSel=''; my $CurInt = $ENV{'form.interval'}; if ($CurInt eq '') {$CurMap = '1';} my $Ptr = '<b>Select number of intervals</b>'."\n". '<select name="interval">'."\n"; for (my $n=1;$n<=7;$n++) { $Ptr .= '<option'; if ($CurInt eq $n) {$Ptr .= ' selected';} $Ptr .= '>'.$n."</option>"."\n"; } $Ptr .= '</select>'."\n"; $r->print( $Ptr ); $r->print('<br><b> Option Response Problems in this course:</b><br><br>'); my $Str = "\n".'<table border=2>'. "\n".'<tr>'. "\n".'<th> # </th>'. "\n".'<th> Problem Title </th>'. "\n".'<th> Resouse </th>'. "\n".'<th> Address </th>'. "\n".'</tr>'; my $P_No=1; foreach (sort keys %OpResp) { my ($rid,$part)=split(/\:/,$OpResp{$_}); my $Temp = '<a href="'.$hash{'src_'.$rid}. '" target="_blank">'.$hash{'title_'.$rid}.'</a>'; $Str .= "\n"."<tr>". "\n"."<td> $P_No </td>". "\n"."<td bgcolor=#DDFFDD> ".$Temp." </td>". "\n"."<td bgcolor=#EEFFCC> ".$hash{'src_'.$rid}." </td>". "\n"."<td> ".'<input type="submit" name="sort" value="'.'Analyze_'.$rid.'" />'.'</td>'. "\n"."</tr>"; $P_No++; } $Str .= "\n".'</table>'; $Str .= "\n".'</form>'; $r->print($Str); $r->rflush(); } sub Decide { my ($type,$foil,$time)=@_; my $k=0; while ($time>$ConceptData{'Int.'.($k+1)} && $k<$ConceptData{'Interval'}) {$k++;} $ConceptData{"$foil_to_concept{$foil}.$k.$type"}++; } sub OpStatus { my ($rid,$student)=@_; my ($uname,$udom)=split(/\:/,$student); my $code='U'; $rid=~/(\d+)\.(\d+)/; my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'. &Apache::lonnet::declutter($hash{'src_'.$rid}); my %reshash=&Apache::lonnet::restore($symb,$cid,$udom,$uname); 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 );} } } } } } } } #------- 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 $Sum1=0; my $Sum2=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++; $Sum1 += $Dis[0]; $Sum2 += $Dis[1]; ($Prb,$tmp)=split(/\=/,$List[$nIdx]); @Dis=split(/\+/,$tmp); } while ( $Prb eq $Temp && $nIdx < $Count ); # $Proc{$Temp}=($Sum1/$nStud).':'.$nStud; $Proc{$Temp}=($Sum1/$nStud).':'.($Sum2/$nStud); # $r->print("$nIdx) $Temp --> ($nStud) $Proc{$Temp} <br>"); $Sum1=0; $Sum2=0; $nStud=0; } return %Proc; } #------- Creating Discimination factor sub Discriminant { my $Count=0; foreach (keys(%DiscFac)){ $Count++; } $UpCnt = int(0.27*$Count); my $low=0; my $up=$Count-$UpCnt; my @UpList=(); my @LowList=(); $Count=0; foreach my $key (sort(keys(%DiscFac))){ $Count++; #$r->print("<br>$Count) $key = $DiscFac{$key}"); if ($low < $UpCnt || $Count > $up) { $low++; my $str=$DiscFac{$key}; foreach(split(/\:/,$str)){ if ($_) { if ($low<$UpCnt){push(@LowList,$_);} else {push(@UpList,$_);} } } } } %DisUp=&ProcessDisc(@UpList); %DisLow=&ProcessDisc(@LowList); } sub NumericSort { $a <=> $b; } # ------ Create different Student Report sub StudentReport { my ($sname,$sdom)=@_; if ( $sname eq 'All Students' ) { $r->print( '<h3><font color=blue>WARNING: Please select a student</font></h3>' ); return; } my %result = &Apache::lonnet::dump($cid,$sdom,$sname); my $ResId; my $PrOrd; 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".'<table border=2>'. "\n".'<tr>'. "\n".'<th> # </th>'. "\n".'<th> Set Title </th>'. "\n".'<th> Results </th>'. "\n".'<th> Tries </th>'. "\n".'</tr>'; my ($temp)=keys(%result); unless ($temp=~/^error\:/) { foreach my $CurCol (@cols) { if (!$CurCol){ my $Set=&Apache::lonnet::declutter($hash{'map_id_'.$1}); if ( $Set ) { $SetNo++; $Str .= "\n"."<tr>". "\n"."<td> $SetNo </td>". "\n"."<td> $Set </td>". "\n"."<td> $PtrCod </td>". "\n"."<td> $PtrTry</td>". "\n"."</tr>"; } $PtrTry=''; $PtrCod=''; next; } ($PrOrd,$ResId)=split(/\:/,$CurCol); $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; foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))){ if ($_=~/^stores\_(\w+)\_tries$/) { my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); if ( $TempHash{"$Part"} eq '' ) { $TempHash{"$Part"} = $Part; $TempHash{$PartNo}=$Part; $TempHash{"$Part.Code"} = '-'; $TempHash{"$Part.PrOrd"} = $PrOrd+$PartNo; $PartNo++; } } } 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; } } } 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".'</table>'; $r->print($Str); $r->rflush(); } sub CreateTable { my ($Hd, $Hid)=@_; if ($ENV{'form.showcsv'}) { if ( $Hd == 1 ) { $r->print('<br>"'.$hash{'title_'.$Hid}.'","'.$hash{'src_'.$Hid}.'"'); } return; } my $ColNo=0; foreach (keys(%Header)){ $ColNo++; } if ( $Hd == 1 ) { $r->print('<br><a href="'.$hash{'src_'.$Hid}. '" target="_blank">'.$hash{'title_'.$Hid}.'</a>'); } my $Result = "\n".'<table border=2>'; $Result .= '<tr><th>P#</th>'."\n"; for ( my $nIdx=0; $nIdx < $ColNo; $nIdx++ ) { $Result .= '<th>'.'<input type="submit" name="sort" value="'. $Header{$nIdx}.'" />'.'</th>'."\n"; } $Result .= "\n".'</tr>'."\n"; $r->print( $Result ); $r->rflush(); } sub CloseTable { if ($ENV{'form.showcsv'}) { return; } $r->print("\n".'</table>'."\n"); $r->rflush(); } # ------------------------------------------- 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 $OpSel11=''; my $OpSel12=''; my $OpSel13=''; my $Status = $ENV{'form.status'}; if ( $Status eq 'Any' ) { $OpSel13='selected'; } elsif ($Status eq 'Expired' ) { $OpSel12 = 'selected'; } else { $OpSel11 = 'selected'; } my $Ptr = ''; $Ptr .= '<br><b> Student Status:   </b>'."\n". '<select name="status">'. '<option '.$OpSel11.' >Active</option>'."\n". '<option '.$OpSel12.' >Expired</option>'."\n". '<option '.$OpSel13.' >Any</option> </select> '."\n"; $Ptr .= '   '; $Ptr .= '<input type=submit name=sort value="Recalculate Statistics"/>'."\n"; $Ptr .= '<br><b> Sorting Type:   </b>'."\n". '<select name="order"> <option '.$OpSel1.' >Ascending</option>'."\n". '<option '.$OpSel2.'>Descending</option> </select> '."\n"; $Ptr .= '   '; $Ptr .= '<input type="submit" name="sort" value="DoDiff Graph" />'."\n"; $Ptr .= '   '; $Ptr .= '<input type="submit" name="sort" value="%Wrong Graph" />'."\n"; $Ptr .= '<pre>'. '<b> #Stdnts</b>: Total Number of Students opened the problem.<br>'. '<b> Tries </b>: Total Number of Tries for solving the problem.<br>'. '<b> Max </b> : Maximunm Number of Tries for solving the problem.<br>'. '<b> Avg. </b>: Average Number of the tries. [ Tries / #Stdnts ]<br>'. '<b> #YES </b>: Number of students solved the problem correctly.<br>'. '<b> #yes </b>: Number of students solved the problem by override.<br>'. '<b> %Wrng </b>: Percentage of students tried to solve the problem but'. ' still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]<br>'. # ' DoDiff : Degree of Difficulty of the problem. [ Tries/(#YES+#yes+0.1) ]<br>'. Kashy formula '<b> DoDiff </b>: Degree of Difficulty of the problem. [ 1 - ((#YES+#yes) / Tries) ]<br>'. #Gerd formula '<b> S.D. </b> : Standard Deviation of the tries.'. '[ sqrt(sum((Xi - Avg.)^2)) / (#Stdnts-1)'. ' where Xi denotes every student\'s tries ]<br>'. '<b> Skew. </b>: Skewness of the students tries.'. ' [ (sqrt( sum((Xi - Avg.)^3) / #Stdnts)) / (S.D.^3) ]<br>'. '<b> Dis.F. </b>: Discrimination Factor: A Standard for '. 'evaluating the problem according to a Criterion<br>'. '<b> [Applied Criterion in %27 Upper Students - '. 'Applied the same Criterion in %27 Lower Students]</b><br>'. '<b> 1st Criterion</b> for Sorting the Students: '. '<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>'. '<b> 2nd Criterion</b> for Sorting the Students: '. '<b>Total number of Correct Answers / Total Number of Tries</b>'. '</pre>'; $r->print($Ptr); $r->print('Output CSV format: <input type=checkbox name=showcsv onClick="submit()"'); if ($ENV{'form.showcsv'}) { $r->print(' checked'); } $r->print('>'); $r->rflush(); 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(%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"); } } # $r->print('Total instances of the problems : '.($p_count*($#students+1))); untie(%CachData); untie(%GraphDat); } # ------------------------------------- Find the section of student in a course sub usection { my ($udom,$unam,$courseid,$ActiveFlag)=@_; $courseid=~s/\_/\//g; $courseid=~s/^(\w)/\/$1/; foreach (split(/\&/,&Apache::lonnet::reply('dump:'. $udom.':'.$unam.':roles', &Apache::lonnet::homeserver($unam,$udom)))){ 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)); if ( $ActiveFlag ne 'Any' ) { my $now=time; my $notactive=0; if ($start) { if ($now<$start) { $notactive=1; } } if ($end) { if ($now>$end) { $notactive=1; } } if ((($ActiveFlag eq 'Expired') && $notactive == 1) || (($ActiveFlag eq 'Active') && $notactive == 0 ) ) { return $section; } else { return '-1'; } } return $section; } } return '-1'; } # ------ Dump the Student's DB file and handling the data for statistics table sub ExtractStudentData { my $student=shift; my ($sname,$sdom) = split( /\:/, $student ); my %result = &Apache::lonnet::dump($cid,$sdom,$sname); my $ResId; my $PrOrd; my $Dis = ''; my $Code; my $Tries; my $ParCr; my $TotalTries = 0; my $TotalOpend = 0; my $ProbSolved = 0; my $ProbTot = 0; my $TimeTot = 0; my $TotParCr = 0; my $Wrongs; my %TempHash; my $Version; my $LatestVersion; my $SecLimit; my $MapLimit; my ($temp)=keys(%result); unless ($temp=~/^error\:/) { foreach my $CurCol(@cols) { ($PrOrd,$ResId)=split(/\:/,$CurCol); if ( !$CurCol ) { next; } $ResId=~/(\d+)\.(\d+)/; my $MapId=$1; my $PrbId=$2; my $MapOrg = $hash{'map_id_'.$MapId}; my $Map = &Apache::lonnet::declutter($MapOrg); if ( $CurMap ne 'All Maps' ) { my ( $ResMap, $NameMap ) = split(/\=/,$CurMap); if ( $Map ne $ResMap ) { next; } } my $meta=$hash{'src_'.$ResId}; my $PartNo = 0; $Dis .= ':'; undef %TempHash; foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { if ($_=~/^stores\_(\w+)\_tries$/) { my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); if ( $TempHash{"$Part"} eq '' ) { $TempHash{"$Part"} = $Part; $TempHash{$PartNo}=$Part; $TempHash{"$Part.Code"} = 'U'; $TempHash{"$Part.PrOrd"} = $PrOrd+$PartNo; $PartNo++; } #my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); } } &Apache::lonnet::declutter( $hash{'src_'.$ResId} ); my $URI = $hash{'src_'.$ResId}; my $Prob = $Map.'___'.$PrbId.'___'. &Apache::lonnet::declutter($URI); $Code='U'; $Tries = 0; $ParCr = 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"}; $ParCr = $result{"$Version:$Prob:resource.$Part.awarded"}; my $Time = $result{"$Version:$Prob:timestamp"}; $TempHash{"$Part.Time"} = ($Time) ? $Time : 0; $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0; $TempHash{"$Part.ParCr"} = ($ParCr) ? $ParCr : 0; $TotalTries += $TempHash{"$Part.Tries"}; $TotParCr += $TempHash{"$Part.ParCr"}; my $Val = $result{"$Version:$Prob:resource.$Part.solved"}; if ( $Val eq 'correct_by_student' ) { $Wrongs = $Tries - 1; $Code = 'C'; } elsif ( $Val eq 'correct_by_override' ) { $Wrongs = $Tries - 1; $Code = 'O'; } elsif ( $Val eq 'incorrect_attempted' || $Val eq 'incorrect_by_override' ) { $Wrongs = $Tries; $Code = 'I'; } $TempHash{"$Part.Code"} = $Code; $TempHash{"$Part.Wrongs"} = $Wrongs; } } } for ( my $n = 0; $n < $PartNo; $n++ ) { my $part = $TempHash{$n}; my $Yes = 0; if ( $TempHash{$part.'.Code'} eq 'C' || $TempHash{$part.'.Code'} eq 'O' ) {$ProbSolved++;$Yes=1;} # my $ptr = "$hash{'title_'.$ResId}"; my $ptr = $TempHash{$part.'.PrOrd'}.'&'.$ResId; if ( $PartNo > 1 ) { $ptr .= "*(part $part)"; $Dis .= '&'; } my $Fac = ($TempHash{"$part.Tries"}) ? ($TempHash{"$part.ParCr"}/$TempHash{"$part.Tries"}) : 0; my $DisF; if ( $Fac > 0 && $Fac < 1 ) { $DisF = sprintf( "%.4f", $Fac ); } else {$DisF = $Fac;} # $DisF .= '+'.$TempHash{"$part.Time"};33333333 $TimeTot += $TempHash{"$part.Time"}; $Dis .= $TempHash{$part.'.PrOrd'}.'='.$DisF.'+'.$Yes; $ptr .= "&$TempHash{$part.'.Tries'}". "&$TempHash{$part.'.Wrongs'}". "&$TempHash{$part.'.Code'}"; push (@list, $ptr); $TotalOpend++; $ProbTot++; } } #else { #for(my $n=0; $n<$PartNo; $n++) { # push (@list, "$TempHash{'0'.'.PrOrd'}.':'.$ResId:0:0:U"); # $ProbTot++; #} #} } if ( $TotalTries ) { my $DisFac = ( $TotalTries ) ? ($TotParCr/$TotalTries) : 0; my $DisFactor = sprintf( "%.4f", $DisFac ); $DiscFac{$DisFactor}=$Dis; #my $time; #if ($ProbSolved){ #$time = int(($TimeTot/$ProbSolved)-10000000); #} #$DiscFac{($DisFactor.':'.$sname.':'.$ProbTot.':'.$TotalOpend.':'. # $TotalTries.':'.$ProbSolved.':'.$time)}=$Dis; } } #$r->print($sname.' PrCr= '.$TotParCr.' Slvd= '.$ProbSolved.' Tries='.$TotalTries.'<br>'); } # ------------------------------------------------------------ Build page table sub tracetable { my ($rid,$beenhere)=@_; my $IsMap=0; $rid=~/(\d+)\.(\d+)/; $maps{&Apache::lonnet::declutter($hash{'map_id_'.$1})}='';#$hash{'title_'.$rid}; #$maps{$HWN}=$hash{'title_'.$rid}; unless ($beenhere=~/\&$rid\&/) { $beenhere.=$rid.'&'; if (defined($hash{'is_map_'.$rid})) { my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}; if ( $cmap eq 'sequence' || $cmap eq 'page' ) { $cols[$#cols+1]=0; $P_Order++; $HWN=$P_Order; $mapsort{$HWN} = $rid.':'; $IsMap=1; #$maps{&Apache::lonnet::declutter($hash{'src_'.$rid})}= # $hash{'title_'.$rid}; } if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) && (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) { my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}}; &tracetable($hash{'map_start_'.$hash{'src_'.$rid}}, '&'.$frid.'&'); $cols[$#cols+1]=($P_Order+1).':'.$frid; my $meta=$hash{'src_'.$frid}; my $PartNo = 0; my $Part; # if ($IsMap==0){ if ($meta) { if ($meta=~/\.(problem|exam|quiz|assess|survey|form)$/) { foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { if ($_=~/^stores\_(\w+)\_tries$/) { $Part=&Apache::lonnet::metadata($meta,$_.'.part'); $P_Order++; $mapsort{$HWN} .= '&'.$P_Order; $PartNo++; #$r->print('<br>'.$PartNo.'---'.$P_Order); } foreach my $K(split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) { if ($K=~/^optionresponse\_($Part)\_(\w+)$/) { #$r->print('<br>'.$_.'...'.$P_Order.'---'.$Part); $OpResp{$P_Order}="$frid:$Part"; } } } } } } # } } else { $cols[$#cols+1]=($P_Order+1).':'.$rid; my $meta=$hash{'src_'.$rid}; my $PartNo = 0; if ($meta) { if ($meta=~/\.(problem|exam|quiz|assess|survey|form)$/) { foreach my $Key(split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { if ($Key=~/^stores\_(\w+)\_tries$/) { my $Part=&Apache::lonnet::metadata($meta,$Key.'.part'); $P_Order++; $mapsort{$HWN} .= '&'.$P_Order; $PartNo++; foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) { if ($_=~/^optionresponse\_($Part)\_(\w+)$/) { #$r->print('<br>'.$_.'...'.$P_Order.'---'.$Part); $OpResp{$P_Order}="$rid:$Part";; } } } } } } } if (defined($hash{'to_'.$rid})) { foreach (split(/\,/,$hash{'to_'.$rid})){ &tracetable($hash{'goesto_'.$_},$beenhere); } } } } sub MySort { if ( $Pos > 0 ) { if ($ENV{'form.order'} eq 'Descending') {$b <=> $a;} else { $a <=> $b; } } else { if ($ENV{'form.order'} eq 'Descending') {$b cmp $a;} else { $a cmp $b; } } } sub Create_PrgWin { #----------- Create progress $r->print(<<ENDPOP); <script> popwin=open('','popwin','width=400,height=100'); popwin.document.writeln('<html><body bgcolor="#88DDFF">'+ '<title>LON-CAPA Statistics</title>'+ '<h4>Computation Progress</h4>'+ '<form name=popremain>'+ '<input type=text size=35 name=remaining value=Starting></form>'+ '</body></html>'); popwin.document.close(); </script> ENDPOP $r->rflush(); } sub Update_PrgWin { #----------- update progress my $index = shift; $r->print('<script>popwin.document.popremain.remaining.value="'. 'Computing '.($index+1).'/'.($#students+1).': '. $students[$index].'";</script>'); $r->rflush(); } sub Close_PrgWin { #--------------------- close Progress Line $r->print('<script>popwin.close()</script>'); $r->rflush(); } sub Build_Statistics { &Create_PrgWin(); # ---------------------------- Gathering the Data of students' tries for (my $index=0;$index<=$#students;$index++) { &Update_PrgWin($index); &ExtractStudentData($students[$index]); } # -------------------- sorting the Data $r->print('<script>popwin.document.popremain.remaining.value="'. 'Calculating Discrimination Factors...";</script>'); @list = sort (@list); &Discriminant(); $OpSel2=''; $OpSel1='selected'; $p_count = 0; my $nIdx = 0; my $dummy; my $p_val; my $ResId; my $NoElements = $#list + 1; #-------------------------------- loop for data representation foreach (sort keys %mapsort) { my ($Hid,$pr)=split(/\:/,$mapsort{$_}); my @lpr=split(/\&/,$pr); &CreateTable(1,$Hid); for (my $i=1; $i<=$#lpr; $i++) { my %storestats=(); my ($PrOrd,$Prob,$Tries,$Wrongs,$Code)=split(/\&/,$list[$nIdx]); my $Temp = $Prob; my $MxTries = 0; my $TotalTries = 0; my $YES = 0; my $Incorrect = 0; my $Override = 0; my $StdNo = 0; my @StdLst; while ( $PrOrd == $lpr[$i] ) { $nIdx++; $StdNo++; $StdLst[ $StdNo ] = $Tries; $TotalTries += $Tries; if ( $MxTries < $Tries ) { $MxTries = $Tries; } if ( $Code eq 'C' ){ $YES++; } elsif( $Code eq 'I' ) { $Incorrect++; } elsif( $Code eq 'O' ) { $Override++; } elsif( $Code eq 'U' ) { $StdNo--; } ($PrOrd,$Prob,$Tries,$Wrongs,$Code)=split(/\&/,$list[$nIdx]); } $p_count++; my $Dummy; ($ResId,$Dummy)=split(/\*/,$Temp); $Temp = '<a href="'.$hash{'src_'.$ResId}. '" target="_blank">'.$hash{'title_'.$ResId}.$Dummy.'</a>'; my $res = &Apache::lonnet::declutter($hash{'src_'.$ResId}); my $urlres=$res; $ResId=~/(\d+)\.(\d+)/; my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} ); $urlres=$Map; $res = '<a href="'.$hash{'src_'.$ResId}.'">'.$res.'</a>'; #$Map = '<a href="'.$Map.'">'.$res.'</a>'; #------------------------ Compute the Average of Tries about one problem my $Average = ($StdNo) ? $TotalTries/$StdNo : 0; $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___timestamp'}=time; $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___stdno'}=$StdNo; $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___avetries'}=$Average; #-------------------------------- Compute percentage of Wrong tries my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0; #-------------------------------- Compute Standard Deviation my $StdDev = 0; if ( $StdNo > 1 ) { for ( my $n = 0; $n < $StdNo; $n++ ) { my $Dif = $StdLst[ $n ]-$Average; $StdDev += $Dif*$Dif; } $StdDev /= ( $StdNo - 1 ); $StdDev = sqrt( $StdDev ); } #-------------------------------- Compute Degree of Difficulty my $DoDiff = 0; if( $TotalTries > 0 ) { $DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries ); # $DoDiff = ($TotalTries)/($YES + $Override+ 0.1); } $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff; #-------------------------------- Compute the Skewness my $Skewness = 0; my $Sum = 0; if ( $StdNo > 0 && $StdDev > 0 ) { for ( my $n = 0; $n < $StdNo; $n++ ) { my $Dif = $StdLst[ $n ]-$Average; $Skewness += $Dif*$Dif*$Dif; } $Skewness /= $StdNo; $Skewness /= $StdDev*$StdDev*$StdDev; } #--------------------- Compute the Discrimination Factors my ($Up1,$Up2)=split(/\:/,$DisUp{$lpr[$i]}); my ($Lw1,$Lw2)=split(/\:/,$DisLow{$lpr[$i]}); my $Dis1 = $Up1 - $Lw1; my $Dis2 = $Up2 - $Lw2; my $_D1 = sprintf("%.2f", $Dis1); my $_D2 = sprintf("%.2f", $Dis2); #----------------- Some restition in presenting the float numbers my $Avg = sprintf( "%.2f", $Average ); my $Wrng = sprintf( "%.1f", $Wrong ); my $SD = sprintf( "%.1f", $StdDev ); my $DoD = sprintf( "%.2f", $DoDiff ); my $Sk = sprintf( "%.1f", $Skewness ); my $join = $lpr[$i].'&'.$Temp.'&'.$StdNo.'&'. $TotalTries.'&'.$MxTries.'&'.$Avg.'&'. $YES.'&'.$Override.'&'.$Wrng.'&'.$DoD.'&'. $SD.'&'.$Sk.'&'.$_D1.'&'.$_D2.'&'. $Prob; $CachData{($p_count-1)}=$join; $urlres=~/^(\w+)\/(\w+)/; if ($StdNo) { &Apache::lonnet::put('resevaldata',\%storestats,$1,$2); } #-------------------------------- Row of statistical table if ( $DiscFlag == 0 ) { &TableRow($join,$i,($p_count-1)); } } &CloseTable(); } &Close_PrgWin(); } sub Cache_Statistics { my @list = (); my $Useful; my $UnUseful; my %myHeader = reverse( %Header ); $Pos = $myHeader{$ENV{'form.sort'}}; if ($Pos > 0) {$Pos++;} $p_count = 0; foreach my $key( keys %CachData) { my @Temp=split(/\&/,$CachData{$key}); if ( $Pos == 0 ) { ($UnUseful,$Useful)=split(/\>/,$Temp[$Pos]); } else { $Useful = $Temp[$Pos]; } $list[$p_count]=$Useful.'@'.$CachData{$key}; $p_count++; } @list = sort MySort (@list); my $nIdx=0; if ( $Pos == 0 ) { foreach (sort keys %mapsort) { my ($Hid,$pr)=split(/\:/,$mapsort{$_}); &CreateTable(1,$Hid); my @lpr=split(/\&/,$pr); for (my $i=1; $i<=$#lpr; $i++) { my($Pre, $Post) = split(/\@/,$list[$nIdx]); #$r->print('<br>'.$Pre.'---'.$Post); &TableRow($Post,$i,$nIdx); $nIdx++; } &CloseTable(); } } else { &CreateTable(0); for ( my $nIdx = 0; $nIdx < $p_count; $nIdx++ ) { my($Pre, $Post) = split(/\@/,$list[$nIdx]); &TableRow($Post,$nIdx,$nIdx); } &CloseTable(); } } sub TableRow { my ($Str,$Idx,$RealIdx)=@_; my($PrOrd,$Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override, $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$Prob)=split(/\&/,$Str); if ($ENV{'form.showcsv'}) { my ($ResId,$Dummy)=split(/\*/,$Prob); my $Ptr = "\n".'<br>'. "\n".'"'.($RealIdx+1).'",'. "\n".'"'.$hash{'title_'.$ResId}.$Dummy.'",'. "\n".'"'.$hash{'src_'.$ResId}.'",'. "\n".'"'.$StdNo.'",'. "\n".'"'.$TotalTries.'",'. "\n".'"'.$MxTries.'",'. "\n".'"'.$Avg.'",'. "\n".'"'.$YES.'",'. "\n".'"'.$Override.'",'. "\n".'"'.$Wrng.'",'. "\n".'"'.$DoD.'",'. "\n".'"'.$SD.'",'. "\n".'"'.$Sk.'",'. "\n".'"'.$_D1.'",'. "\n".'"'.$_D2.'"'; $r->print("\n".$Ptr); } else{ my $Ptr = "\n".'<tr>'. "\n".'<td>'.($RealIdx+1).'</td>'. # "\n".'<td>'.$PrOrd.$Temp.'</td>'. "\n".'<td>'.$Temp.'</td>'. "\n".'<td bgcolor="#EEFFCC"> '.$StdNo.'</td>'. "\n".'<td bgcolor="#EEFFCC">'.$TotalTries.'</td>'. "\n".'<td bgcolor="#EEFFCC">'.$MxTries.'</td>'. "\n".'<td bgcolor="#DDFFFF">'.$Avg.'</td>'. "\n".'<td bgcolor="#DDFFFF"> '.$YES.'</td>'. "\n".'<td bgcolor="#DDFFFF"> '.$Override.'</td>'. "\n".'<td bgcolor="#FFDDDD"> '.$Wrng.'</td>'. "\n".'<td bgcolor="#FFDDDD">'.$DoD.'</td>'. "\n".'<td bgcolor="#DDFFDD"> '.$SD.'</td>'. "\n".'<td bgcolor="#DDFFDD"> '.$Sk.'</td>'. "\n".'<td bgcolor="#FFDDFF"> '.$_D1.'</td>'. "\n".'<td bgcolor="#FFDDFF"> '.$_D2.'</td>'; $r->print("\n".$Ptr.'</tr>' ); } $GraphDat{$RealIdx}=$DoD.':'.$Wrng; } # ------------------------------------------- Prepare data for Graphical chart sub GetGraphData { my $ylab = shift; my $Col; my $data=''; my $count = 0; my $Max = 0; my $cid=$ENV{'request.course.id'}; 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 ( $ylab eq 'DoDiff Graph' ) { $ylab = 'Degree-of-Difficulty'; $Col = 0; } else { $ylab = 'Wrong-Percentage'; $Col = 1; } foreach (sort NumericSort keys %GraphDat) { my @Temp=split(/\:/,$GraphDat{$_}); my $inf = $Temp[$Col]; 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'}; $Course =~ s/\ /"_"/eg; $GData=$Course.'&'.'Problems'.'&'.$ylab.'&'.$Max.'&'.$count.'&'.$data; } else { $r->print("Unable to tie hash to db file"); } } } 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 %OpResp; undef %ConceptData; undef $CurMap; undef $CurSec; undef $CurStu; undef $p_count; undef $Pos; undef $GData; $DiscFlag=0; $P_Order=100000; $HWN=$P_Order; } sub ClassList { &GetStatus(); $cid=$ENV{'request.course.id'}; my $chome=$ENV{'course.'.$cid.'.home'}; my ($cdom,$cnum)=split(/\_/,$cid); # ----------------------- Get first and last resource, see if there is anything $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}}; $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}}; if (($firstres) && ($lastres)) { #my %result = &Apache::lonnet::dump('classlist',$sdom,$sname); my $classlst=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':classlist',$chome); my $StudNo = 0; my $now=time; unless ($classlst=~/^error\:/) { foreach (sort split(/\&/,$classlst)) { my ($name,$value)=split(/\=/,$_); my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); $name=&Apache::lonnet::unescape($name); my ($sname,$sdom)=split(/\:/,$name); my $active=1; my $Status=$ENV{'form.status'}; $Status = ($Status) ? $Status : 'Active'; if ( ( ($end) && $now > $end ) && ( ($Status eq 'Active') ) ) { $active=0; } if ( ($Status eq 'Expired') && ($end == 0 || $now < $end) ) { $active=0; } if ($active) { my $thisindex=$#students+1; $name=&Apache::lonnet::unescape($name); $students[$thisindex]=$name; my ($sname,$sdom)=split(/\:/,$name); #my %reply=&Apache::lonnet::idrget($sdom,$sname); #my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname. # ':environment:lastname&generation&firstname&middlename', # &Apache::lonnet::homeserver($sname,$sdom)); my $ssec=&usection($sdom,$sname,$cid,$Status); # if ($ssec==-1 ) {next;} if ($ssec==-1 || $ssec eq 'adm' ) {next;} $ssec=($ssec) ? $ssec : '(none)'; #$ssec=(int($ssec)) ? int($ssec) : $ssec; $section{$ssec}=$ssec; if ($CurSec eq 'All Sections' || $ssec eq $CurSec) { $students[$StudNo]=$name; $StuBox{$sname}=$sdom; } $StudNo++; } } } else { $r->print('<h1>Could not access course data</h1>'); } $r->print("Total number of students : ".($#students+1)); $r->rflush(); # --------------- Find all assessments and put them into some linear-like order &tracetable($firstres,'&'.$lastres.'&'); # my $c=0; # foreach (sort keys %mapsort) { # $r->print('<br>'.$c.')'.$_.' ... '.$mapsort{$_}); # $c++; # } # my $c=1; # foreach (sort keys %OpResp) { # $r->print('<br>'.$c.')'.$_.' ... '.$OpResp{$_}.' ... '.$hash{'src_'.$OpResp{$_}}); # $c++; # } } # ------------------------------------------------------------- End render page else { $r->print('<h3>Undefined course sequence</h3>'); } } sub Title { $r->print('<html><head><title>LON-CAPA Statistics</title></head>'); $r->print('<body bgcolor="#FFFFFF">'. '<script>window.focus(); window.width=500;window.height=500;</script>'. '<img align=right src=/adm/lonIcons/lonlogos.gif>'); # ---------------------------------------------------------------- Course title $r->print('<h1> Course : "'. $ENV{'course.'.$ENV{'request.course.id'}. '.description'}.'"</h1><h2>'.localtime().'</h2>'); # ------------------------------- This is going to take a while, produce output $r->rflush(); } sub CreateForm { $r->print("\n".'<form name=stat method=post action="/adm/statistics" >'); my $content = $ENV{'form.sort'}; if (!($ENV{'form.showcsv'}) && ($content eq '' || $content eq 'Return to Menu')) { my $Ptr = '<h3>'; $Ptr .= '<input type=submit name=sort value="Problem Stats"/>'; $Ptr .= '<br><br>'; $Ptr .= '<input type=submit name=sort value="Problem Analysis"/>'; $Ptr .= '<br><br>'; $Ptr .= '<input type=submit name=sort value="Student Assessment"/>'; $Ptr .= '</h3>'; $r->print( $Ptr ); } else { if ( $content eq 'Student Assessment' || $content eq 'Create Student Report' ) { &MapSecOptions(); &StudentOptions(); &StudentReport($CurStu,$StuBox{"$CurStu"}); } elsif ( $content eq 'Problem Analysis' ) { &AnalyzeProblem(); } else { &MapSecOptions(); &PreStatTable(); } } } sub Menu { &initial(); #$Apache::lonxml::debug=1; #&Apache::lonhomework::showhash(%ENV); #$Apache::lonxml::debug=0; &Title(); &ClassList(); my $InpStr = $ENV{'form.sort'}; if ($InpStr=~/^Analyze\_/) { &ShowOpGraph($InpStr,$ENV{'form.interval'}); } elsif ( $InpStr eq 'DoDiff Graph' || $InpStr eq '%Wrong Graph' ) { &GetGraphData($InpStr); $r->print('<IMG src="/cgi-bin/graph.gif?'.$GData.'" />'); } else { &CreateForm(); $r->print("\n".'</form>'); } $r->print("\n".'</body>'. "\n".'</html>'); $r->rflush(); } sub StudentOptions { my $OpSel5=''; $CurStu = $ENV{'form.student'}; if ( $CurStu eq '' ) { $CurStu = 'All Students'; $OpSel5 = 'selected'; } my $Ptr =''; # ----------------------------------- Loading the Students Combobox $Ptr .= '<br><b>Select Student</b>'."\n". '<select name="student">'."\n". '<option '.$OpSel5.'>All Students</option>'; foreach my $key ( sort keys %StuBox ) { $Ptr .= '<option'; if ($CurStu eq $key) {$Ptr .= ' selected';} $Ptr .= '>'.$key."</option>\n"; } $Ptr .= '</select>'; $Ptr .= '<br><input type="submit" name="sort" value="Create Student Report" />'; $r->print( $Ptr ); $r->rflush(); } sub GetStatus { $OpSel1=''; $OpSel2=''; $OpSel3=''; $OpSel4=''; if ( $ENV{'form.order'} eq 'Descending' ) { $OpSel2='selected'; } else { $OpSel1 = 'selected'; } my %myHeader = reverse( %Header ); $Pos = $myHeader{$ENV{'form.sort'}}; if ($Pos == 0) { $OpSel1 = 'selected'; $ENV{'form.order'}='Ascendig'; } $CurMap = $ENV{'form.maps'}; if ( $CurMap eq '' ) { $CurMap = 'All Maps'; $OpSel3 = 'selected'; } $CurSec = $ENV{'form.section'}; if ( $CurSec eq '' ) { $CurSec = 'All Sections'; $OpSel4 = 'selected'; } } sub MapSecOptions { # ----------------------------------- Loading the Maps Combobox my $Ptr = ''; $Ptr .= '<input type="submit" name="sort" value="Return to Menu" />'; $Ptr .= '<br><b> Select   Map     </b>'."\n". '<select name="maps">'."\n". '<option '.$OpSel3.'>All Maps</option>'; foreach my $key ( sort keys %maps ) { $Ptr .= '<option'; if ($CurMap eq $key) {$Ptr .= ' selected';} $Ptr .= '>'.$key."</option>\n"; } $Ptr .= '</select>'; $Ptr .= '   '; # ----------------------------------- Loading the Sections Combobox $Ptr .= '<br><b>Select Section</b>'."\n". '<select name="section">'."\n". '<option '.$OpSel4.'>All Sections</option>'; foreach my $key ( sort keys %section ) { $Ptr .= '<option'; if ($CurSec eq $key) {$Ptr .= ' selected';} $Ptr .= '>'.$key."</option>"."\n"; } $Ptr .= '</select>'."\n"; $r->print( $Ptr ); $r->rflush(); } # ================================================================ Main Handler sub handler { $r=shift; if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { # ------------------------------------------- Set document type for header only if ($r->header_only) { if ($ENV{'browser.mathml'}) { $r->content_type('text/xml'); } else { $r->content_type('text/html'); } $r->send_http_header; return OK; } my $requrl=$r->uri; # ----------------------------------------------------------------- Tie db file undef %hash; if ($ENV{'request.course.fn'}) { my $fn=$ENV{'request.course.fn'}; if (-e "$fn.db") { if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) { # ------------------------------------------------------------------- Hash tied $r->content_type('text/html'); $r->send_http_header; &Menu(); } else { $r->content_type('text/html'); $r->send_http_header; $r->print('<html><body>Coursemap undefined.</body></html>'); } # ------------------------------------------------------------------ Untie hash unless (untie(%hash)) { &Apache::lonnet::logthis("<font color=blue>WARNING: ". "Could not untie coursemap $fn (browse).</font>"); } # -------------------------------------------------------------------- All done return OK; # ----------------------------------------------- Errors, hash could no be tied } } else { $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; return HTTP_NOT_ACCEPTABLE; } } else { $ENV{'user.error.msg'}= $r->uri.":vgr:0:0:Cannot view grades for complete course"; return HTTP_NOT_ACCEPTABLE; } } 1; __END__