![]() ![]() | ![]() |
Fixed some bugs in analysis problem's graph
1: # The LearningOnline Network with CAPA 2: # (Publication Handler 3: # 4: # $Id: lonstatistics.pm,v 1.19 2002/05/16 01:27:05 minaeibi Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # (Navigate problems for statistical reports 29: # YEAR=2001 30: # 5/5,7/9,7/25/1,8/11,9/13,9/26,10/5,10/9,10/22,10/26 Behrouz Minaei 31: # 11/1,11/4,11/16,12/14,12/16,12/18,12/20,12/31 Behrouz Minaei 32: # YEAR=2002 33: # 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 34: # 5/12, 5/14, 5/15 Behrouz Minaei 35: # 36: ### 37: 38: package Apache::lonstatistics; 39: 40: use strict; 41: use Apache::Constants qw(:common :http); 42: use Apache::lonnet(); 43: use Apache::lonhomework; 44: use Apache::loncommon; 45: use HTML::TokeParser; 46: use GDBM_File; 47: 48: # -------------------------------------------------------------- Module Globals 49: my %hash; 50: my %CachData; 51: my %GraphDat; 52: my %OpResp; 53: my %maps; 54: my %mapsort; 55: my %section; 56: my %StuBox; 57: my %DiscFac; 58: my %DisUp; 59: my %DisLow; 60: my $UpCnt; 61: my $CurMap; 62: my $CurSec; 63: my $CurStu; 64: my @cols; 65: my @list; 66: my @students; 67: my $p_count; 68: my $Pos; 69: my $r; 70: my $OpSel1; 71: my $OpSel2; 72: my $OpSel3; 73: my $OpSel4; 74: my $GData; 75: my $cid; 76: my $firstres; 77: my $lastres; 78: my $DiscFlag; 79: my $HWN; 80: my $P_Order; 81: my %foil_to_concept; 82: my @Concepts; 83: my %ConceptData; 84: my %Header = (0,"Homework Sets Order",1,"#Stdnts",2,"Tries",3,"Mod", 85: 4,"Mean",5,"#YES",6,"#yes",7,"%Wrng",8,"DoDiff", 86: 9,"S.D.",10,"Skew.",11,"D.F.1st",12,"D.F.2nd"); 87: my %Answer = (); 88: 89: sub InitAnalysis { 90: my ($rid, $student)=@_; 91: my ($uname,$udom)=split(/\:/,$student); 92: $rid=~/(\d+)\.(\d+)/; 93: my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'. 94: &Apache::lonnet::declutter($hash{'src_'.$rid}); 95: my $URI = $hash{'src_'.$rid}; 96: my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze', 97: 'grade_username' => $uname, 98: 'grade_domain' => $udom, 99: 'grade_courseid' => $cid, 100: 'grade_symb' => $symb)); 101: # my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze')); 102: 103: (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2); 104: %Answer=(); 105: %Answer=&Apache::lonnet::str2hash($Answ); 106: 107: my $parts=''; 108: foreach my $elm (@{$Answer{"parts"}}) { 109: $parts.="$elm,"; 110: } 111: chop($parts); 112: my $conc=''; 113: foreach my $elm (@{$Answer{"$parts.concepts"}}) { 114: $conc.="$elm@"; 115: } 116: chop($conc); 117: 118: @Concepts=split(/\@/,$conc); 119: foreach my $concept (@{$Answer{"$parts.concepts"}}) { 120: foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) { 121: $foil_to_concept{$foil} = $concept; 122: #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"}; 123: } 124: } 125: return $symb; 126: } 127: 128: 129: sub Interval { 130: my ($rid,$part,$symb)=@_; 131: my $Int=$ConceptData{"Interval"}; 132: my $due = &Apache::lonnet::EXT('resource.$part.duedate',$symb)+1; 133: my $opn = &Apache::lonnet::EXT('resource.$part.opendate',$symb); 134: my $add=int(($due-$opn)/$Int); 135: $ConceptData{"Int.0"}=$opn; 136: for (my $i=1;$i<$Int;$i++) { 137: $ConceptData{"Int.$i"}=$opn+$i*$add; 138: } 139: $ConceptData{"Int.$Int"}=$due; 140: for (my $i=0;$i<$Int;$i++) { 141: for (my $n=0; $n<=$#Concepts; $n++ ) { 142: my $tmp=$Concepts[$n]; 143: $ConceptData{"$tmp.$i.true"}=0; 144: $ConceptData{"$tmp.$i.false"}=0; 145: } 146: } 147: } 148: 149: 150: sub ShowOpGraph { 151: my ($InpStr, $Int_No)=@_; 152: my ($rid,$part)=split(/\:/,substr($InpStr,8)); 153: $ConceptData{"Interval"}=$Int_No; 154: #Initialize the option response true answers 155: my $symb=&InitAnalysis($rid,$students[0]); 156: #compute the intervals 157: &Interval($rid,$part,$symb); 158: my $URI = $hash{'src_'.$rid}; 159: my $Src = $hash{'title_'.$rid}; 160: $Src =~ s/\ /"_"/eg; 161: $r->print('<br><b>'.$URI.'</b>'); 162: $r->rflush(); 163: 164: #Java script Progress window 165: &Create_PrgWin(); 166: &Update_PrgWin("Starting to analyze problem"); 167: for (my $index=0;$index<=$#students;$index++) { 168: &Update_PrgWin($index); 169: &OpStatus($rid,$students[$index]); 170: } 171: &Close_PrgWin(); 172: 173: $r->print('<br>'); 174: for (my $k=0; $k<$Int_No; $k++ ) { 175: &DrawGraph($k,$Src); 176: } 177: #$Apache::lonxml::debug=1; 178: #&Apache::lonhomework::showhash(%ConceptData); 179: #$Apache::lonxml::debug=0; 180: my $Answ=&Apache::lonnet::ssi($URI); 181: $r->print("<br><b>Here you can see the Problem:</b><br>$Answ"); 182: } 183: 184: 185: sub DrawGraph { 186: my ($k,$Src)=@_; 187: my $Max=0; 188: my @data1; 189: my @data2; 190: my $Correct=0; 191: my $Wrong=0; 192: # Adjust Data and find the Max 193: for (my $n=0; $n<=$#Concepts; $n++ ) { 194: my $tmp=$Concepts[$n]; 195: $data1[$n]=$ConceptData{"$tmp.$k.true"}; 196: $Correct+=$data1[$n]; 197: $data2[$n]=$ConceptData{"$tmp.$k.false"}; 198: $Wrong+=$data2[$n]; 199: my $Sum=$data1[$n]+$data2[$n]; 200: if ( $Max<$Sum ) {$Max=$Sum;} 201: } 202: for (my $n=0; $n<=$#Concepts; $n++ ) { 203: if ($data1[$n]+$data2[$n]<$Max) { 204: $data2[$n]+=$Max-($data1[$n]+$data2[$n]); 205: } 206: } 207: my $P_No = $#data1+1; 208: # $r->print('<br><b>From: ['.localtime($ConceptData{'Int.'.($k-1)}). 209: # '] To: ['.localtime($ConceptData{"Int.$k"}).']</b>'); 210: my $Str = "\n".'<table border=2>'. 211: "\n".'<tr>'. 212: "\n".'<th> # </th>'. 213: "\n".'<th> Concept </th>'. 214: "\n".'<th> Correct </th>'. 215: "\n".'<th> Wrong </th>'. 216: "\n".'</tr>'; 217: 218: for (my $n=0; $n<=$#Concepts; $n++ ) { 219: $Str .= "\n"."<tr>". 220: "\n"."<td>".($n+1)."</td>". 221: "\n"."<td bgcolor=#FFFFDD> ".$Concepts[$n]." </td>". 222: "\n"."<td bgcolor=#DDFFDD> ".$data1[$n]." </td>". 223: "\n"."<td bgcolor=#FFDDDD> ".$data2[$n]." </td>". 224: "\n"."</tr>"; 225: } 226: #$Apache::lonxml::debug=1; 227: #&Apache::lonhomework::showhash(%ConceptData); 228: #$Apache::lonxml::debug=0; 229: 230: # $Str.='<td></td><td><b>From:['.localtime($ConceptData{'Int.$k'}). 231: # '] To: ['.localtime($ConceptData{'Int.'.($k+1)}). 232: # "]</b></td><td>$Correct</td><td>$Wrong</td>";# 233: 234: $Str .= "\n".'</table>'; 235: 236: # $r->print($Str); 237: 238: if ( $Max > 1 ) { 239: $Max += (10 - $Max % 10); 240: $Max = int($Max); 241: } else { $Max = 1; } 242: 243: 244: my $Titr=($ConceptData{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src; 245: # $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2; 246: $GData="$Titr&Concepts&Answers&$Max&$P_No&". 247: (join(',',@data1)).'&'.(join(',',@data2)); 248: 249: $r->print('<IMG src="/cgi-bin/graph.gif?'.$GData.'" border=1/>'); 250: } 251: 252: 253: sub AnalyzeProblem { 254: # selecting the number of intervals 255: my $OpSel=''; 256: my $CurInt = $ENV{'form.interval'}; 257: if ($CurInt eq '') {$CurMap = '1';} 258: my $Ptr = '<b>Select number of intervals</b>'."\n". 259: '<select name="interval">'."\n"; 260: for (my $n=1;$n<=7;$n++) { 261: $Ptr .= '<option'; 262: if ($CurInt eq $n) {$Ptr .= ' selected';} 263: $Ptr .= '>'.$n."</option>"."\n"; 264: } 265: $Ptr .= '</select>'."\n"; 266: $r->print( $Ptr ); 267: 268: #the table of option response problems 269: $r->print('<br><b> Option Response Problems in this course:</b><br><br>'); 270: my $Str = "\n".'<table border=2>'. 271: "\n".'<tr>'. 272: "\n".'<th> # </th>'. 273: "\n".'<th> Problem Title </th>'. 274: "\n".'<th> Resouse </th>'. 275: "\n".'<th> Address </th>'. 276: "\n".'</tr>'; 277: 278: my $P_No=1; 279: foreach (sort keys %OpResp) { 280: my ($rid,$part)=split(/\:/,$OpResp{$_}); 281: my $Temp = '<a href="'.$hash{'src_'.$rid}. 282: '" target="_blank">'.$hash{'title_'.$rid}.'</a>'; 283: $Str .= "\n"."<tr>". 284: "\n"."<td> $P_No </td>". 285: "\n"."<td bgcolor=#DDFFDD> ".$Temp." </td>". 286: "\n"."<td bgcolor=#EEFFCC> ".$hash{'src_'.$rid}." </td>". 287: "\n"."<td> ".'<input type="submit" name="sort" value="'.'Analyze_'.$rid.'" />'.'</td>'. 288: "\n"."</tr>"; 289: $P_No++; 290: } 291: $Str .= "\n".'</table>'; 292: $Str .= "\n".'</form>'; 293: $r->print($Str); 294: $r->rflush(); 295: } 296: 297: 298: sub Decide { 299: #deciding the true or false answer belongs to each interval 300: my ($type,$foil,$time)=@_; 301: my $k=0; 302: while ($time>$ConceptData{'Int.'.($k+1)} && 303: $k<$ConceptData{'Interval'}) {$k++;} 304: $ConceptData{"$foil_to_concept{$foil}.$k.$type"}++; 305: } 306: 307: 308: #restore the student submissions and finding the result 309: sub OpStatus { 310: my ($rid,$student)=@_; 311: my ($uname,$udom)=split(/\:/,$student); 312: my $code='U'; 313: $rid=~/(\d+)\.(\d+)/; 314: my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'. 315: &Apache::lonnet::declutter($hash{'src_'.$rid}); 316: my %reshash=&Apache::lonnet::restore($symb,$cid,$udom,$uname); 317: my @True = (); 318: my @False = (); 319: my $flag=0; 320: if ($reshash{'version'}) { 321: my $tries=0; 322: &Apache::lonhomework::showhash(%Answer); 323: for (my $version=1;$version<=$reshash{'version'};$version++) { 324: my $time=$reshash{"$version:timestamp"}; 325: 326: foreach my $key (sort(split(/\:/,$reshash{$version.':keys'}))) { 327: if (($key=~/\.(\w+)\.(\w+)\.submission$/)) { 328: my $Id1 = $1; my $Id2 = $2; 329: #check if this is a repeat submission, if so skip it 330: if ($reshash{"$version:resource.$Id1.previous"}) { next; } 331: #if no solved this wasn't a real submission, ignore it 332: if (!defined($reshash{"$version:resource.$Id1.solved"})) { 333: &Apache::lonxml::debug("skipping "); 334: next; 335: } 336: my $Resp = $reshash{"$version:$key"}; 337: my %submission=&Apache::lonnet::str2hash($Resp); 338: foreach (keys %submission) { 339: my $Ansr = $Answer{"$Id1.$Id2.foil.value.$_"}; 340: if ($submission{$_}) { 341: if ($submission{$_} eq $Ansr) { 342: &Decide("true",$_,$time ); 343: } 344: else {&Decide("false",$_,$time );} 345: } 346: } 347: } 348: } 349: } 350: } 351: } 352: 353: 354: #------- Processing upperlist and lowerlist according to each problem 355: sub ProcessDisc { 356: my @List = @_; 357: @List = sort (@List); 358: my $Count = $#List+1; 359: my $Prb; 360: my @Dis; 361: my $Slvd=0; 362: my $tmp; 363: my $Sum1=0; 364: my $Sum2=0; 365: my $nIdx=0; 366: my $nStud=0; 367: my %Proc; 368: undef %Proc; 369: while ($nIdx<$Count) { 370: ($Prb,$tmp)=split(/\=/,$List[$nIdx]); 371: @Dis=split(/\+/,$tmp); 372: my $Temp = $Prb; 373: do { 374: $nIdx++; 375: $nStud++; 376: $Sum1 += $Dis[0]; 377: $Sum2 += $Dis[1]; 378: ($Prb,$tmp)=split(/\=/,$List[$nIdx]); 379: @Dis=split(/\+/,$tmp); 380: } while ( $Prb eq $Temp && $nIdx < $Count ); 381: # $Proc{$Temp}=($Sum1/$nStud).':'.$nStud; 382: $Proc{$Temp}=($Sum1/$nStud).':'.($Sum2/$nStud); 383: # $r->print("$nIdx) $Temp --> ($nStud) $Proc{$Temp} <br>"); 384: $Sum1=0; 385: $Sum2=0; 386: $nStud=0; 387: } 388: return %Proc; 389: } 390: 391: 392: #------- Creating Discimination factor 393: sub Discriminant { 394: my $Count=0; 395: foreach (keys(%DiscFac)){ 396: $Count++; 397: } 398: $UpCnt = int(0.27*$Count); 399: my $low=0; 400: my $up=$Count-$UpCnt; 401: my @UpList=(); 402: my @LowList=(); 403: $Count=0; 404: foreach my $key (sort(keys(%DiscFac))){ 405: $Count++; 406: #$r->print("<br>$Count) $key = $DiscFac{$key}"); 407: if ($low < $UpCnt || $Count > $up) { 408: $low++; 409: my $str=$DiscFac{$key}; 410: foreach(split(/\:/,$str)){ 411: if ($_) { 412: if ($low<$UpCnt){push(@LowList,$_);} 413: else {push(@UpList,$_);} 414: } 415: } 416: } 417: } 418: %DisUp=&ProcessDisc(@UpList); 419: %DisLow=&ProcessDisc(@LowList); 420: } 421: 422: 423: sub NumericSort { 424: $a <=> $b; 425: } 426: 427: # ------ Create different Student Report 428: sub StudentReport { 429: my ($sname,$sdom)=@_; 430: if ( $sname eq 'All Students' ) { 431: $r->print( '<h3><font color=blue>WARNING: 432: Please select a student</font></h3>' ); 433: return; 434: } 435: my %result = &Apache::lonnet::dump($cid,$sdom,$sname); 436: my $ResId; 437: my $PrOrd; 438: my $Code; 439: my $Tries; 440: my $TotalTries = 0; 441: my $ParCr = 0; 442: my $Wrongs; 443: my %TempHash; 444: my $Version; 445: my $LatestVersion; 446: my $PtrTry=''; 447: my $PtrCod=''; 448: my $SetNo=0; 449: my $Str = "\n".'<table border=2>'. 450: "\n".'<tr>'. 451: "\n".'<th> # </th>'. 452: "\n".'<th> Set Title </th>'. 453: "\n".'<th> Results </th>'. 454: "\n".'<th> Tries </th>'. 455: "\n".'</tr>'; 456: my ($temp)=keys(%result); 457: unless ($temp=~/^error\:/) { 458: foreach my $CurCol (@cols) { 459: if (!$CurCol){ 460: my $Set=&Apache::lonnet::declutter($hash{'map_id_'.$1}); 461: if ( $Set ) { 462: $SetNo++; 463: $Str .= "\n"."<tr>". 464: "\n"."<td> $SetNo </td>". 465: "\n"."<td> $Set </td>". 466: "\n"."<td> $PtrCod </td>". 467: "\n"."<td> $PtrTry</td>". 468: "\n"."</tr>"; 469: } 470: $PtrTry=''; 471: $PtrCod=''; 472: next; 473: } 474: ($PrOrd,$ResId)=split(/\:/,$CurCol); 475: $ResId=~/(\d+)\.(\d+)/; 476: my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} ); 477: if ( $CurMap ne 'All Maps' ) { 478: my ( $ResMap, $NameMap ) = split(/\=/,$CurMap); 479: if ( $Map ne $ResMap ) { next; } 480: } 481: my $meta=$hash{'src_'.$ResId}; 482: my $PartNo = 0; 483: undef %TempHash; 484: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))){ 485: if ($_=~/^stores\_(\w+)\_tries$/) { 486: my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); 487: if ( $TempHash{"$Part"} eq '' ) { 488: $TempHash{"$Part"} = $Part; 489: $TempHash{$PartNo}=$Part; 490: $TempHash{"$Part.Code"} = '-'; 491: $TempHash{"$Part.PrOrd"} = $PrOrd+$PartNo; 492: $PartNo++; 493: } 494: } 495: } 496: 497: my $Prob = $Map.'___'.$2.'___'. 498: &Apache::lonnet::declutter( $hash{'src_'.$ResId} ); 499: $Code='U'; 500: $Tries = 0; 501: $Wrongs = 0; 502: $LatestVersion = $result{"version:$Prob"}; 503: if ( $LatestVersion ) { 504: for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) { 505: my $vkeys = $result{"$Version:keys:$Prob"}; 506: my @keys = split(/\:/,$vkeys); 507: 508: foreach my $Key (@keys) { 509: if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) { 510: my $Part = $1; 511: $Tries = $result{"$Version:$Prob:resource.$Part.tries"}; 512: $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0; 513: $TotalTries += $Tries; 514: my $Val = $result{"$Version:$Prob:resource.$Part.solved"}; 515: if ( $Val eq 'correct_by_student' ) 516: { $Wrongs = $Tries - 1; $Code = 'Y'; } 517: elsif ( $Val eq 'correct_by_override' ) 518: { $Wrongs = $Tries - 1; $Code = 'y'; } 519: elsif ( $Val eq 'incorrect_attempted' || 520: $Val eq 'incorrect_by_override' ) 521: { $Wrongs = $Tries; $Code = 'N'; } 522: $TempHash{"$Part.Code"} = $Code; 523: $TempHash{"$Part.Wrongs"} = $Wrongs; 524: } 525: } 526: } 527: for ( my $n = 0; $n < $PartNo; $n++ ) { 528: my $part = $TempHash{$n}; 529: if ($PtrTry ne '') {$PtrTry .= ',';} 530: $PtrTry .= "$TempHash{$part.'.Tries'}"; 531: $PtrCod .= "$TempHash{$part.'.Code'}"; 532: } 533: } 534: else { 535: for(my $n=0; $n<$PartNo; $n++) { 536: if ($PtrTry ne '') {$PtrTry .= ',';} 537: $PtrTry .= "0"; 538: $PtrCod .= "-"; 539: } 540: } 541: } 542: } 543: $Str .= "\n".'</table>'; 544: $r->print($Str); 545: $r->rflush(); 546: } 547: 548: sub CreateTable { 549: my ($Hd, $Hid)=@_; 550: if ($ENV{'form.showcsv'}) { 551: if ( $Hd == 1 ) { 552: $r->print('<br>"'.$hash{'title_'.$Hid}.'","'.$hash{'src_'.$Hid}.'"'); 553: } 554: return; 555: } 556: my $ColNo=0; 557: foreach (keys(%Header)){ 558: $ColNo++; 559: } 560: if ( $Hd == 1 ) { 561: $r->print('<br><a href="'.$hash{'src_'.$Hid}. 562: '" target="_blank">'.$hash{'title_'.$Hid}.'</a>'); 563: } 564: my $Result = "\n".'<table border=2>'; 565: $Result .= '<tr><th>P#</th>'."\n"; 566: for ( my $nIdx=0; $nIdx < $ColNo; $nIdx++ ) { 567: $Result .= '<th>'.'<input type="submit" name="sort" value="'. 568: $Header{$nIdx}.'" />'.'</th>'."\n"; 569: } 570: $Result .= "\n".'</tr>'."\n"; 571: $r->print( $Result ); 572: $r->rflush(); 573: } 574: 575: sub CloseTable { 576: if ($ENV{'form.showcsv'}) { 577: return; 578: } 579: $r->print("\n".'</table>'."\n"); 580: $r->rflush(); 581: } 582: 583: # ------------------------------------------- Prepare Statistics Table 584: sub PreStatTable { 585: 586: my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". 587: "_$ENV{'user.domain'}_$cid\_statistics.db"; 588: my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". 589: "_$ENV{'user.domain'}_$cid\_graph.db"; 590: my $OpSel11=''; 591: my $OpSel12=''; 592: my $OpSel13=''; 593: my $Status = $ENV{'form.status'}; 594: if ( $Status eq 'Any' ) { $OpSel13='selected'; } 595: elsif ($Status eq 'Expired' ) { $OpSel12 = 'selected'; } 596: else { $OpSel11 = 'selected'; } 597: 598: my $Ptr = ''; 599: $Ptr .= '<br><b> Student Status: </b>'."\n". 600: '<select name="status">'. 601: '<option '.$OpSel11.' >Active</option>'."\n". 602: '<option '.$OpSel12.' >Expired</option>'."\n". 603: '<option '.$OpSel13.' >Any</option> </select> '."\n"; 604: $Ptr .= ' '; 605: $Ptr .= '<input type=submit name=sort value="Recalculate Statistics"/>'."\n"; 606: 607: $Ptr .= '<br><b> Sorting Type: </b>'."\n". 608: '<select name="order"> <option '.$OpSel1.' >Ascending</option>'."\n". 609: '<option '.$OpSel2.'>Descending</option> </select> '."\n"; 610: $Ptr .= ' '; 611: $Ptr .= '<input type="submit" name="sort" value="DoDiff Graph" />'."\n"; 612: $Ptr .= ' '; 613: $Ptr .= '<input type="submit" name="sort" value="%Wrong Graph" />'."\n"; 614: 615: $Ptr .= '<pre>'. 616: '<b> #Stdnts</b>: Total Number of Students opened the problem.<br>'. 617: '<b> Tries </b>: Total Number of Tries for solving the problem.<br>'. 618: '<b> Max </b> : Maximunm Number of Tries for solving the problem.<br>'. 619: '<b> Avg. </b>: Average Number of the tries. [ Tries / #Stdnts ]<br>'. 620: '<b> #YES </b>: Number of students solved the problem correctly.<br>'. 621: '<b> #yes </b>: Number of students solved the problem by override.<br>'. 622: '<b> %Wrng </b>: Percentage of students tried to solve the problem but'. 623: ' still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]<br>'. 624: # ' DoDiff : Degree of Difficulty of the problem. [ Tries/(#YES+#yes+0.1) ]<br>'. Kashy formula 625: '<b> DoDiff </b>: Degree of Difficulty of the problem. [ 1 - ((#YES+#yes) / Tries) ]<br>'. #Gerd formula 626: '<b> S.D. </b> : Standard Deviation of the tries.'. 627: '[ sqrt(sum((Xi - Avg.)^2)) / (#Stdnts-1)'. 628: ' where Xi denotes every student\'s tries ]<br>'. 629: '<b> Skew. </b>: Skewness of the students tries.'. 630: ' [ (sqrt( sum((Xi - Avg.)^3) / #Stdnts)) / (S.D.^3) ]<br>'. 631: '<b> Dis.F. </b>: Discrimination Factor: A Standard for '. 632: 'evaluating the problem according to a Criterion<br>'. 633: '<b> [Applied Criterion in %27 Upper Students - '. 634: 'Applied the same Criterion in %27 Lower Students]</b><br>'. 635: '<b> 1st Criterion</b> for Sorting the Students: '. 636: '<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>'. 637: '<b> 2nd Criterion</b> for Sorting the Students: '. 638: '<b>Total number of Correct Answers / Total Number of Tries</b>'. 639: '</pre>'; 640: 641: $r->print($Ptr); 642: 643: $r->print('Output CSV format: <input type=checkbox name=showcsv onClick="submit()"'); 644: if ($ENV{'form.showcsv'}) { $r->print(' checked'); } 645: $r->print('>'); 646: 647: $r->rflush(); 648: 649: if ((-e "$CacheDB")&&($ENV{'form.sort'} ne 'Recalculate Statistics')) { 650: if (tie(%CachData,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) { 651: tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640); 652: &Cache_Statistics(); 653: } 654: else { 655: $r->print("Unable to tie hash to db file"); 656: } 657: } 658: else { 659: if (tie(%CachData,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) { 660: tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640); 661: foreach (keys %DiscFac) {delete $CachData{$_};} 662: foreach (keys %CachData) {delete $CachData{$_};} 663: $DiscFlag=0; 664: &Build_Statistics(); 665: } 666: else { 667: $r->print("Unable to tie hash to db file"); 668: } 669: } 670: 671: # $r->print('Total instances of the problems : '.($p_count*($#students+1))); 672: untie(%CachData); 673: untie(%GraphDat); 674: } 675: 676: 677: # ------------------------------------- Find the section of student in a course 678: 679: sub usection { 680: my ($udom,$unam,$courseid,$ActiveFlag)=@_; 681: $courseid=~s/\_/\//g; 682: $courseid=~s/^(\w)/\/$1/; 683: foreach (split(/\&/,&Apache::lonnet::reply('dump:'. 684: $udom.':'.$unam.':roles', 685: &Apache::lonnet::homeserver($unam,$udom)))){ 686: my ($key,$value)=split(/\=/,$_); 687: $key=&Apache::lonnet::unescape($key); 688: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) { 689: my $section=$1; 690: if ($key eq $courseid.'_st') { $section=''; } 691: my ($dummy,$end,$start)=split(/\_/,&Apache::lonnet::unescape($value)); 692: if ( $ActiveFlag ne 'Any' ) { 693: my $now=time; 694: my $notactive=0; 695: if ($start) { 696: if ($now<$start) { $notactive=1; } 697: } 698: if ($end) { 699: if ($now>$end) { $notactive=1; } 700: } 701: if ((($ActiveFlag eq 'Expired') && $notactive == 1) || 702: (($ActiveFlag eq 'Active') && $notactive == 0 ) ) { 703: return $section; 704: } 705: else { return '-1'; } 706: } 707: return $section; 708: } 709: } 710: return '-1'; 711: } 712: 713: 714: # ------ Dump the Student's DB file and handling the data for statistics table 715: sub ExtractStudentData { 716: my $student=shift; 717: my ($sname,$sdom) = split( /\:/, $student ); 718: my %result = &Apache::lonnet::dump($cid,$sdom,$sname); 719: my $ResId; 720: my $PrOrd; 721: my $Dis = ''; 722: my $Code; 723: my $Tries; 724: my $ParCr; 725: my $TotalTries = 0; 726: my $TotalOpend = 0; 727: my $ProbSolved = 0; 728: my $ProbTot = 0; 729: my $TimeTot = 0; 730: my $TotParCr = 0; 731: my $Wrongs; 732: my %TempHash; 733: my $Version; 734: my $LatestVersion; 735: my $SecLimit; 736: my $MapLimit; 737: my ($temp)=keys(%result); 738: unless ($temp=~/^error\:/) { 739: foreach my $CurCol(@cols) { 740: ($PrOrd,$ResId)=split(/\:/,$CurCol); 741: if ( !$CurCol ) { next; } 742: $ResId=~/(\d+)\.(\d+)/; 743: my $MapId=$1; 744: my $PrbId=$2; 745: my $MapOrg = $hash{'map_id_'.$MapId}; 746: my $Map = &Apache::lonnet::declutter($MapOrg); 747: if ( $CurMap ne 'All Maps' ) { 748: my ( $ResMap, $NameMap ) = split(/\=/,$CurMap); 749: if ( $Map ne $ResMap ) { next; } 750: } 751: my $meta=$hash{'src_'.$ResId}; 752: my $PartNo = 0; 753: $Dis .= ':'; 754: undef %TempHash; 755: 756: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { 757: if ($_=~/^stores\_(\w+)\_tries$/) { 758: my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); 759: if ( $TempHash{"$Part"} eq '' ) { 760: $TempHash{"$Part"} = $Part; 761: $TempHash{$PartNo}=$Part; 762: $TempHash{"$Part.Code"} = 'U'; 763: $TempHash{"$Part.PrOrd"} = $PrOrd+$PartNo; 764: $PartNo++; 765: } 766: #my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); 767: } 768: } 769: &Apache::lonnet::declutter( $hash{'src_'.$ResId} ); 770: my $URI = $hash{'src_'.$ResId}; 771: my $Prob = $Map.'___'.$PrbId.'___'. 772: &Apache::lonnet::declutter($URI); 773: $Code='U'; 774: $Tries = 0; 775: $ParCr = 0; 776: $Wrongs = 0; 777: $LatestVersion = $result{"version:$Prob"}; 778: if ( $LatestVersion ) { 779: for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) { 780: my $vkeys = $result{"$Version:keys:$Prob"}; 781: my @keys = split(/\:/,$vkeys); 782: foreach my $Key (@keys) { 783: if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) { 784: my $Part = $1; 785: $Tries = $result{"$Version:$Prob:resource.$Part.tries"}; 786: $ParCr = $result{"$Version:$Prob:resource.$Part.awarded"}; 787: my $Time = $result{"$Version:$Prob:timestamp"}; 788: $TempHash{"$Part.Time"} = ($Time) ? $Time : 0; 789: $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0; 790: $TempHash{"$Part.ParCr"} = ($ParCr) ? $ParCr : 0; 791: $TotalTries += $TempHash{"$Part.Tries"}; 792: $TotParCr += $TempHash{"$Part.ParCr"}; 793: my $Val = $result{"$Version:$Prob:resource.$Part.solved"}; 794: if ( $Val eq 'correct_by_student' ) 795: { $Wrongs = $Tries - 1; $Code = 'C'; } 796: elsif ( $Val eq 'correct_by_override' ) 797: { $Wrongs = $Tries - 1; $Code = 'O'; } 798: elsif ( $Val eq 'incorrect_attempted' || 799: $Val eq 'incorrect_by_override' ) 800: { $Wrongs = $Tries; $Code = 'I'; } 801: $TempHash{"$Part.Code"} = $Code; 802: $TempHash{"$Part.Wrongs"} = $Wrongs; 803: } 804: } 805: } 806: for ( my $n = 0; $n < $PartNo; $n++ ) { 807: my $part = $TempHash{$n}; 808: my $Yes = 0; 809: if ( $TempHash{$part.'.Code'} eq 'C' || 810: $TempHash{$part.'.Code'} eq 'O' ) 811: {$ProbSolved++;$Yes=1;} 812: 813: # my $ptr = "$hash{'title_'.$ResId}"; 814: my $ptr = $TempHash{$part.'.PrOrd'}.'&'.$ResId; 815: 816: if ( $PartNo > 1 ) { 817: $ptr .= "*(part $part)"; 818: $Dis .= '&'; 819: } 820: my $Fac = ($TempHash{"$part.Tries"}) ? 821: ($TempHash{"$part.ParCr"}/$TempHash{"$part.Tries"}) : 0; 822: my $DisF; 823: if ( $Fac > 0 && $Fac < 1 ) { 824: $DisF = sprintf( "%.4f", $Fac ); 825: } 826: else {$DisF = $Fac;} 827: # $DisF .= '+'.$TempHash{"$part.Time"};33333333 828: $TimeTot += $TempHash{"$part.Time"}; 829: $Dis .= $TempHash{$part.'.PrOrd'}.'='.$DisF.'+'.$Yes; 830: $ptr .= "&$TempHash{$part.'.Tries'}". 831: "&$TempHash{$part.'.Wrongs'}". 832: "&$TempHash{$part.'.Code'}"; 833: push (@list, $ptr); 834: $TotalOpend++; 835: $ProbTot++; 836: } 837: } 838: #else { 839: #for(my $n=0; $n<$PartNo; $n++) { 840: # push (@list, "$TempHash{'0'.'.PrOrd'}.':'.$ResId:0:0:U"); 841: # $ProbTot++; 842: #} 843: #} 844: } 845: if ( $TotalTries ) { 846: my $DisFac = ( $TotalTries ) ? ($TotParCr/$TotalTries) : 0; 847: my $DisFactor = sprintf( "%.4f", $DisFac ); 848: $DiscFac{$DisFactor}=$Dis; 849: #my $time; 850: #if ($ProbSolved){ 851: #$time = int(($TimeTot/$ProbSolved)-10000000); 852: #} 853: #$DiscFac{($DisFactor.':'.$sname.':'.$ProbTot.':'.$TotalOpend.':'. 854: # $TotalTries.':'.$ProbSolved.':'.$time)}=$Dis; 855: } 856: } 857: #$r->print($sname.' PrCr= '.$TotParCr.' Slvd= '.$ProbSolved.' Tries='.$TotalTries.'<br>'); 858: } 859: 860: 861: # ------------------------------------------------------------ Build page table 862: sub tracetable { 863: my ($rid,$beenhere)=@_; 864: my $IsMap=0; 865: $rid=~/(\d+)\.(\d+)/; 866: $maps{&Apache::lonnet::declutter($hash{'map_id_'.$1})}='';#$hash{'title_'.$rid}; 867: #$maps{$HWN}=$hash{'title_'.$rid}; 868: unless ($beenhere=~/\&$rid\&/) { 869: $beenhere.=$rid.'&'; 870: if (defined($hash{'is_map_'.$rid})) { 871: my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}; 872: if ( $cmap eq 'sequence' || $cmap eq 'page' ) { 873: $cols[$#cols+1]=0; 874: $P_Order++; 875: $HWN=$P_Order; 876: $mapsort{$HWN} = $rid.':'; 877: $IsMap=1; 878: 879: #$maps{&Apache::lonnet::declutter($hash{'src_'.$rid})}= 880: # $hash{'title_'.$rid}; 881: } 882: if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) && 883: (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) { 884: my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}}; 885: 886: &tracetable($hash{'map_start_'.$hash{'src_'.$rid}}, 887: '&'.$frid.'&'); 888: 889: $cols[$#cols+1]=($P_Order+1).':'.$frid; 890: 891: my $meta=$hash{'src_'.$frid}; 892: my $PartNo = 0; 893: my $Part; 894: # if ($IsMap==0){ 895: if ($meta) { 896: if ($meta=~/\.(problem|exam|quiz|assess|survey|form)$/) { 897: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { 898: if ($_=~/^stores\_(\w+)\_tries$/) { 899: $Part=&Apache::lonnet::metadata($meta,$_.'.part'); 900: $P_Order++; 901: $mapsort{$HWN} .= '&'.$P_Order; 902: $PartNo++; 903: #$r->print('<br>'.$PartNo.'---'.$P_Order); 904: } 905: foreach my $K(split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) { 906: if ($K=~/^optionresponse\_($Part)\_(\w+)$/) { 907: #$r->print('<br>'.$_.'...'.$P_Order.'---'.$Part); 908: $OpResp{$P_Order}="$frid:$Part"; 909: } 910: } 911: } 912: } 913: } 914: } 915: # } 916: } else { 917: $cols[$#cols+1]=($P_Order+1).':'.$rid; 918: my $meta=$hash{'src_'.$rid}; 919: my $PartNo = 0; 920: if ($meta) { 921: if ($meta=~/\.(problem|exam|quiz|assess|survey|form)$/) { 922: foreach my $Key(split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { 923: if ($Key=~/^stores\_(\w+)\_tries$/) { 924: my $Part=&Apache::lonnet::metadata($meta,$Key.'.part'); 925: $P_Order++; 926: $mapsort{$HWN} .= '&'.$P_Order; 927: $PartNo++; 928: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) { 929: if ($_=~/^optionresponse\_($Part)\_(\w+)$/) { 930: #$r->print('<br>'.$_.'...'.$P_Order.'---'.$Part); 931: $OpResp{$P_Order}="$rid:$Part";; 932: } 933: 934: } 935: 936: } 937: } 938: } 939: } 940: } 941: if (defined($hash{'to_'.$rid})) { 942: foreach (split(/\,/,$hash{'to_'.$rid})){ 943: &tracetable($hash{'goesto_'.$_},$beenhere); 944: } 945: } 946: } 947: } 948: 949: sub MySort { 950: if ( $Pos > 0 ) { 951: if ($ENV{'form.order'} eq 'Descending') {$b <=> $a;} 952: else { $a <=> $b; } 953: } 954: else { 955: if ($ENV{'form.order'} eq 'Descending') {$b cmp $a;} 956: else { $a cmp $b; } 957: } 958: } 959: 960: sub Create_PrgWin { 961: #----------- Create progress 962: $r->print(<<ENDPOP); 963: <script> 964: popwin=open('','popwin','width=400,height=100'); 965: popwin.document.writeln('<html><body bgcolor="#88DDFF">'+ 966: '<title>LON-CAPA Statistics</title>'+ 967: '<h4>Computation Progress</h4>'+ 968: '<form name=popremain>'+ 969: '<input type=text size=35 name=remaining value=Starting></form>'+ 970: '</body></html>'); 971: popwin.document.close(); 972: </script> 973: ENDPOP 974: 975: $r->rflush(); 976: } 977: 978: 979: sub Update_PrgWin { 980: #----------- update progress 981: my $index = shift; 982: $r->print('<script>popwin.document.popremain.remaining.value="'. 983: 'Computing '.($index+1).'/'.($#students+1).': '. 984: $students[$index].'";</script>'); 985: $r->rflush(); 986: } 987: 988: sub Close_PrgWin { 989: #--------------------- close Progress Line 990: $r->print('<script>popwin.close()</script>'); 991: $r->rflush(); 992: } 993: 994: sub Build_Statistics { 995: &Create_PrgWin(); 996: # ---------------------------- Gathering the Data of students' tries 997: for (my $index=0;$index<=$#students;$index++) { 998: &Update_PrgWin($index); 999: &ExtractStudentData($students[$index]); 1000: } 1001: 1002: # -------------------- sorting the Data 1003: $r->print('<script>popwin.document.popremain.remaining.value="'. 1004: 'Calculating Discrimination Factors...";</script>'); 1005: 1006: @list = sort (@list); 1007: 1008: &Discriminant(); 1009: 1010: $OpSel2=''; 1011: $OpSel1='selected'; 1012: 1013: $p_count = 0; 1014: my $nIdx = 0; 1015: my $dummy; 1016: my $p_val; 1017: my $ResId; 1018: my $NoElements = $#list + 1; 1019: #-------------------------------- loop for data representation 1020: foreach (sort keys %mapsort) { 1021: my ($Hid,$pr)=split(/\:/,$mapsort{$_}); 1022: my @lpr=split(/\&/,$pr); 1023: &CreateTable(1,$Hid); 1024: for (my $i=1; $i<=$#lpr; $i++) { 1025: my %storestats=(); 1026: my ($PrOrd,$Prob,$Tries,$Wrongs,$Code)=split(/\&/,$list[$nIdx]); 1027: my $Temp = $Prob; 1028: my $MxTries = 0; 1029: my $TotalTries = 0; 1030: my $YES = 0; 1031: my $Incorrect = 0; 1032: my $Override = 0; 1033: my $StdNo = 0; 1034: my @StdLst; 1035: while ( $PrOrd == $lpr[$i] ) 1036: { 1037: $nIdx++; 1038: $StdNo++; 1039: $StdLst[ $StdNo ] = $Tries; 1040: $TotalTries += $Tries; 1041: if ( $MxTries < $Tries ) { $MxTries = $Tries; } 1042: if ( $Code eq 'C' ){ $YES++; } 1043: elsif( $Code eq 'I' ) { $Incorrect++; } 1044: elsif( $Code eq 'O' ) { $Override++; } 1045: elsif( $Code eq 'U' ) { $StdNo--; } 1046: ($PrOrd,$Prob,$Tries,$Wrongs,$Code)=split(/\&/,$list[$nIdx]); 1047: } 1048: 1049: $p_count++; 1050: my $Dummy; 1051: ($ResId,$Dummy)=split(/\*/,$Temp); 1052: 1053: $Temp = '<a href="'.$hash{'src_'.$ResId}. 1054: '" target="_blank">'.$hash{'title_'.$ResId}.$Dummy.'</a>'; 1055: 1056: my $res = &Apache::lonnet::declutter($hash{'src_'.$ResId}); 1057: my $urlres=$res; 1058: 1059: $ResId=~/(\d+)\.(\d+)/; 1060: my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} ); 1061: $urlres=$Map; 1062: 1063: $res = '<a href="'.$hash{'src_'.$ResId}.'">'.$res.'</a>'; 1064: #$Map = '<a href="'.$Map.'">'.$res.'</a>'; 1065: 1066: #------------------------ Compute the Average of Tries about one problem 1067: my $Average = ($StdNo) ? $TotalTries/$StdNo : 0; 1068: 1069: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___timestamp'}=time; 1070: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___stdno'}=$StdNo; 1071: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___avetries'}=$Average; 1072: 1073: #-------------------------------- Compute percentage of Wrong tries 1074: my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0; 1075: 1076: #-------------------------------- Compute Standard Deviation 1077: my $StdDev = 0; 1078: if ( $StdNo > 1 ) { 1079: for ( my $n = 0; $n < $StdNo; $n++ ) { 1080: my $Dif = $StdLst[ $n ]-$Average; 1081: $StdDev += $Dif*$Dif; 1082: } 1083: $StdDev /= ( $StdNo - 1 ); 1084: $StdDev = sqrt( $StdDev ); 1085: } 1086: 1087: #-------------------------------- Compute Degree of Difficulty 1088: my $DoDiff = 0; 1089: if( $TotalTries > 0 ) { 1090: $DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries ); 1091: # $DoDiff = ($TotalTries)/($YES + $Override+ 0.1); 1092: } 1093: 1094: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff; 1095: 1096: #-------------------------------- Compute the Skewness 1097: my $Skewness = 0; 1098: my $Sum = 0; 1099: if ( $StdNo > 0 && $StdDev > 0 ) { 1100: for ( my $n = 0; $n < $StdNo; $n++ ) { 1101: my $Dif = $StdLst[ $n ]-$Average; 1102: $Skewness += $Dif*$Dif*$Dif; 1103: } 1104: $Skewness /= $StdNo; 1105: $Skewness /= $StdDev*$StdDev*$StdDev; 1106: } 1107: 1108: #--------------------- Compute the Discrimination Factors 1109: my ($Up1,$Up2)=split(/\:/,$DisUp{$lpr[$i]}); 1110: my ($Lw1,$Lw2)=split(/\:/,$DisLow{$lpr[$i]}); 1111: my $Dis1 = $Up1 - $Lw1; 1112: my $Dis2 = $Up2 - $Lw2; 1113: my $_D1 = sprintf("%.2f", $Dis1); 1114: my $_D2 = sprintf("%.2f", $Dis2); 1115: 1116: #----------------- Some restition in presenting the float numbers 1117: my $Avg = sprintf( "%.2f", $Average ); 1118: my $Wrng = sprintf( "%.1f", $Wrong ); 1119: my $SD = sprintf( "%.1f", $StdDev ); 1120: my $DoD = sprintf( "%.2f", $DoDiff ); 1121: my $Sk = sprintf( "%.1f", $Skewness ); 1122: my $join = $lpr[$i].'&'.$Temp.'&'.$StdNo.'&'. 1123: $TotalTries.'&'.$MxTries.'&'.$Avg.'&'. 1124: $YES.'&'.$Override.'&'.$Wrng.'&'.$DoD.'&'. 1125: $SD.'&'.$Sk.'&'.$_D1.'&'.$_D2.'&'. 1126: $Prob; 1127: $CachData{($p_count-1)}=$join; 1128: 1129: $urlres=~/^(\w+)\/(\w+)/; 1130: if ($StdNo) { 1131: &Apache::lonnet::put('resevaldata',\%storestats,$1,$2); 1132: } 1133: #-------------------------------- Row of statistical table 1134: if ( $DiscFlag == 0 ) { 1135: &TableRow($join,$i,($p_count-1)); 1136: } 1137: } 1138: &CloseTable(); 1139: } 1140: &Close_PrgWin(); 1141: } 1142: 1143: sub Cache_Statistics { 1144: my @list = (); 1145: my $Useful; 1146: my $UnUseful; 1147: my %myHeader = reverse( %Header ); 1148: #&Apache::lonnet::delenv('form_'); 1149: #&Apache::lonnet::delenv('test'); 1150: $Pos = $myHeader{$ENV{'form.sort'}}; 1151: if ($Pos > 0) {$Pos++;} 1152: $p_count = 0; 1153: foreach my $key( keys %CachData) { 1154: my @Temp=split(/\&/,$CachData{$key}); 1155: if ( $Pos == 0 ) { 1156: ($UnUseful,$Useful)=split(/\>/,$Temp[$Pos]); 1157: } 1158: else { 1159: $Useful = $Temp[$Pos]; 1160: } 1161: $list[$p_count]=$Useful.'@'.$CachData{$key}; 1162: $p_count++; 1163: } 1164: 1165: @list = sort MySort (@list); 1166: 1167: my $nIdx=0; 1168: 1169: if ( $Pos == 0 ) { 1170: foreach (sort keys %mapsort) { 1171: my ($Hid,$pr)=split(/\:/,$mapsort{$_}); 1172: &CreateTable(1,$Hid); 1173: my @lpr=split(/\&/,$pr); 1174: for (my $i=1; $i<=$#lpr; $i++) { 1175: my($Pre, $Post) = split(/\@/,$list[$nIdx]); 1176: #$r->print('<br>'.$Pre.'---'.$Post); 1177: &TableRow($Post,$i,$nIdx); 1178: $nIdx++; 1179: } 1180: &CloseTable(); 1181: } 1182: } 1183: else { 1184: &CreateTable(0); 1185: for ( my $nIdx = 0; $nIdx < $p_count; $nIdx++ ) { 1186: my($Pre, $Post) = split(/\@/,$list[$nIdx]); 1187: &TableRow($Post,$nIdx,$nIdx); 1188: } 1189: &CloseTable(); 1190: } 1191: } 1192: 1193: sub TableRow { 1194: my ($Str,$Idx,$RealIdx)=@_; 1195: my($PrOrd,$Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override, 1196: $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$Prob)=split(/\&/,$Str); 1197: if ($ENV{'form.showcsv'}) { 1198: my ($ResId,$Dummy)=split(/\*/,$Prob); 1199: my $Ptr = "\n".'<br>'. 1200: "\n".'"'.($RealIdx+1).'",'. 1201: "\n".'"'.$hash{'title_'.$ResId}.$Dummy.'",'. 1202: "\n".'"'.$hash{'src_'.$ResId}.'",'. 1203: "\n".'"'.$StdNo.'",'. 1204: "\n".'"'.$TotalTries.'",'. 1205: "\n".'"'.$MxTries.'",'. 1206: "\n".'"'.$Avg.'",'. 1207: "\n".'"'.$YES.'",'. 1208: "\n".'"'.$Override.'",'. 1209: "\n".'"'.$Wrng.'",'. 1210: "\n".'"'.$DoD.'",'. 1211: "\n".'"'.$SD.'",'. 1212: "\n".'"'.$Sk.'",'. 1213: "\n".'"'.$_D1.'",'. 1214: "\n".'"'.$_D2.'"'; 1215: $r->print("\n".$Ptr); 1216: } 1217: else{ 1218: my $Ptr = "\n".'<tr>'. 1219: "\n".'<td>'.($RealIdx+1).'</td>'. 1220: # "\n".'<td>'.$PrOrd.$Temp.'</td>'. 1221: "\n".'<td>'.$Temp.'</td>'. 1222: "\n".'<td bgcolor="#EEFFCC"> '.$StdNo.'</td>'. 1223: "\n".'<td bgcolor="#EEFFCC">'.$TotalTries.'</td>'. 1224: "\n".'<td bgcolor="#EEFFCC">'.$MxTries.'</td>'. 1225: "\n".'<td bgcolor="#DDFFFF">'.$Avg.'</td>'. 1226: "\n".'<td bgcolor="#DDFFFF"> '.$YES.'</td>'. 1227: "\n".'<td bgcolor="#DDFFFF"> '.$Override.'</td>'. 1228: "\n".'<td bgcolor="#FFDDDD"> '.$Wrng.'</td>'. 1229: "\n".'<td bgcolor="#FFDDDD">'.$DoD.'</td>'. 1230: "\n".'<td bgcolor="#DDFFDD"> '.$SD.'</td>'. 1231: "\n".'<td bgcolor="#DDFFDD"> '.$Sk.'</td>'. 1232: "\n".'<td bgcolor="#FFDDFF"> '.$_D1.'</td>'. 1233: "\n".'<td bgcolor="#FFDDFF"> '.$_D2.'</td>'; 1234: $r->print("\n".$Ptr.'</tr>' ); 1235: } 1236: $GraphDat{$RealIdx}=$DoD.':'.$Wrng; 1237: } 1238: 1239: # ------------------------------------------- Prepare data for Graphical chart 1240: 1241: sub GetGraphData { 1242: my $ylab = shift; 1243: my $Col; 1244: my $data=''; 1245: my $count = 0; 1246: my $Max = 0; 1247: my $cid=$ENV{'request.course.id'}; 1248: my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". 1249: "_$ENV{'user.domain'}_$cid\_graph.db"; 1250: foreach (keys %GraphDat) {delete $GraphDat{$_};} 1251: if (-e "$GraphDB") { 1252: if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) { 1253: if ( $ylab eq 'DoDiff Graph' ) { 1254: $ylab = 'Degree-of-Difficulty'; 1255: $Col = 0; 1256: } 1257: else { 1258: $ylab = 'Wrong-Percentage'; 1259: $Col = 1; 1260: } 1261: foreach (sort NumericSort keys %GraphDat) { 1262: my @Temp=split(/\:/,$GraphDat{$_}); 1263: my $inf = $Temp[$Col]; 1264: if ( $Max < $inf ) {$Max = $inf;} 1265: $data .= $inf.','; 1266: $count++; 1267: } 1268: if ( $Max > 1 ) { 1269: $Max += (10 - $Max % 10); 1270: $Max = int($Max); 1271: } 1272: else { $Max = 1; } 1273: untie(%GraphDat); 1274: my $Course = $ENV{'course.'.$cid.'.description'}; 1275: $Course =~ s/\ /"_"/eg; 1276: $GData=$Course.'&'.'Problems'.'&'.$ylab.'&'.$Max.'&'.$count.'&'.$data; 1277: } 1278: else { 1279: $r->print("Unable to tie hash to db file"); 1280: } 1281: } 1282: } 1283: 1284: 1285: sub initial { 1286: # --------------------------------- Initialize the global varaibles 1287: undef @students; 1288: undef @cols; 1289: undef %maps; 1290: undef %section; 1291: undef %StuBox; 1292: undef @list; 1293: undef %CachData; 1294: undef %GraphDat; 1295: undef %DiscFac; 1296: undef %OpResp; 1297: undef %ConceptData; 1298: undef $CurMap; 1299: undef $CurSec; 1300: undef $CurStu; 1301: undef $p_count; 1302: undef $Pos; 1303: undef $GData; 1304: $DiscFlag=0; 1305: $P_Order=100000; 1306: $HWN=$P_Order; 1307: } 1308: 1309: # my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". 1310: # "_$ENV{'user.domain'}_$cid\_classlist.db"; 1311: # if (-e "$CacheDB") { 1312: # if (tie(%students,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) { 1313: # &CachClassList(); 1314: # } 1315: # else { 1316: # $r->print("Unable to tie hash to db file"); 1317: # } 1318: # } 1319: # else { 1320: # if (tie(%students,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) { 1321: # &MakeClassList(); 1322: # } 1323: # else { 1324: # $r->print("Unable to tie hash to db file"); 1325: # } 1326: # } 1327: # untie(%students); 1328: 1329: 1330: sub ClassList { 1331: 1332: &GetStatus(); 1333: 1334: $cid=$ENV{'request.course.id'}; 1335: my $chome=$ENV{'course.'.$cid.'.home'}; 1336: my ($cdom,$cnum)=split(/\_/,$cid); 1337: # ----------------------- Get first and last resource, see if there is anything 1338: $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}}; 1339: $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}}; 1340: if (($firstres) && ($lastres)) { 1341: # my %students = &Apache::lonnet::dump('classlist',$cdom,$cnum); 1342: # $Apache::lonxml::debug=1; 1343: # &Apache::lonhomework::showhash(%students); 1344: # $Apache::lonxml::debug=0; 1345: # my $StudNo = 0; 1346: # my $now=time; 1347: # my ($temp)=keys(%students); 1348: # unless ($temp=~/^error\:/) { 1349: # foreach my $KeyPoint(sort keys(%students)) { 1350: my $classlst=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':classlist',$chome); 1351: my $StudNo = 0; 1352: my $now=time; 1353: unless ($classlst=~/^error\:/) { 1354: foreach my $KeyPoint(sort split(/\&/,$classlst)) { 1355: my ($name,$value)=split(/\=/,$KeyPoint); 1356: my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); 1357: my $active=1; 1358: my $Status=$ENV{'form.status'}; 1359: $Status = ($Status) ? $Status : 'Active'; 1360: if ( ( ($end) && $now > $end ) && 1361: ( ($Status eq 'Active') ) ) { $active=0; } 1362: 1363: if ( ($Status eq 'Expired') && 1364: ($end == 0 || $now < $end) ) { $active=0; } 1365: 1366: if ($active) { 1367: my $thisindex=$#students+1; 1368: $name=&Apache::lonnet::unescape($name); 1369: $students[$thisindex]=$name; 1370: my ($sname,$sdom)=split(/\:/,$name); 1371: my $ssec=&usection($sdom,$sname,$cid,$Status); 1372: if ($ssec==-1 || $ssec eq 'adm' ) {next;} 1373: $ssec=($ssec) ? $ssec : '(none)'; 1374: #$ssec=(int($ssec)) ? int($ssec) : $ssec; 1375: $section{$ssec}=$ssec; 1376: if ($CurSec eq 'All Sections' || $ssec eq $CurSec) { 1377: $students[$StudNo]=$name; 1378: $StuBox{$sname}=$sdom; 1379: } 1380: $StudNo++; 1381: } 1382: } 1383: } 1384: else { 1385: $r->print('<h1>Could not access course data</h1>'); 1386: } 1387: $r->print("Total number of students : ".($#students+1)); 1388: $r->rflush(); 1389: # --------------- Find all assessments and put them into some linear-like order 1390: &tracetable($firstres,'&'.$lastres.'&'); 1391: # my $c=0; 1392: # foreach (sort keys %mapsort) { 1393: # $r->print('<br>'.$c.')'.$_.' ... '.$mapsort{$_}); 1394: # $c++; 1395: # } 1396: # my $c=1; 1397: # foreach (sort keys %OpResp) { 1398: # $r->print('<br>'.$c.')'.$_.' ... '.$OpResp{$_}.' ... '.$hash{'src_'.$OpResp{$_}}); 1399: # $c++; 1400: # } 1401: 1402: } 1403: 1404: # ------------------------------------------------------------- End render page 1405: else { 1406: $r->print('<h3>Undefined course sequence</h3>'); 1407: } 1408: } 1409: 1410: 1411: sub ClassListnew { 1412: 1413: &GetStatus(); 1414: 1415: $cid=$ENV{'request.course.id'}; 1416: my $chome=$ENV{'course.'.$cid.'.home'}; 1417: my ($cdom,$cnum)=split(/\_/,$cid); 1418: # ----------------------- Get first and last resource, see if there is anything 1419: $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}}; 1420: $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}}; 1421: if (($firstres) && ($lastres)) { 1422: 1423: my %students = &Apache::lonnet::dump('classlist',$cdom,$cnum); 1424: my $StudNo = 0; 1425: my $now=time; 1426: my ($temp)=keys(%students); 1427: unless ($temp=~/^error\:/) { 1428: foreach (sort keys(%students)) { 1429: my ($name,$value)=split(/\=/,$_); 1430: my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); 1431: $name=&Apache::lonnet::unescape($name); 1432: my ($sname,$sdom)=split(/\:/,$name); 1433: my $active=1; 1434: my $Status=$ENV{'form.status'}; 1435: $Status = ($Status) ? $Status : 'Active'; 1436: if ( ( ($end) && $now > $end ) && 1437: ( ($Status eq 'Active') ) ) { $active=0; } 1438: if ( ($Status eq 'Expired') && 1439: ($end == 0 || $now < $end) ) { $active=0; } 1440: if ($active) { 1441: my $thisindex=$#students+1; 1442: $name=&Apache::lonnet::unescape($name); 1443: $students[$thisindex]=$name; 1444: my ($sname,$sdom)=split(/\:/,$name); 1445: #my %reply=&Apache::lonnet::idrget($sdom,$sname); 1446: #my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname. 1447: # ':environment:lastname&generation&firstname&middlename', 1448: # &Apache::lonnet::homeserver($sname,$sdom)); 1449: my $ssec=&usection($sdom,$sname,$cid,$Status); 1450: # if ($ssec==-1 ) {next;} 1451: if ($ssec==-1 || $ssec eq 'adm' ) {next;} 1452: $ssec=($ssec) ? $ssec : '(none)'; 1453: #$ssec=(int($ssec)) ? int($ssec) : $ssec; 1454: $section{$ssec}=$ssec; 1455: if ($CurSec eq 'All Sections' || $ssec eq $CurSec) { 1456: $students[$StudNo]=$name; 1457: $StuBox{$sname}=$sdom; 1458: } 1459: $StudNo++; 1460: } 1461: } 1462: } 1463: else { 1464: $r->print('<h1>Could not access course data</h1>'); 1465: } 1466: $r->print("Total number of students : ".($#students+1)); 1467: $r->rflush(); 1468: # --------------- Find all assessments and put them into some linear-like order 1469: &tracetable($firstres,'&'.$lastres.'&'); 1470: } 1471: 1472: # ------------------------------------------------------------- End render page 1473: else { 1474: $r->print('<h3>Undefined course sequence</h3>'); 1475: } 1476: } 1477: 1478: 1479: sub Title { 1480: $r->print('<html><head><title>LON-CAPA Statistics</title></head>'); 1481: $r->print('<body bgcolor="#FFFFFF">'. 1482: '<script>window.focus(); window.width=500;window.height=500;</script>'. 1483: '<img align=right src=/adm/lonIcons/lonlogos.gif>'); 1484: # ---------------------------------------------------------------- Course title 1485: $r->print('<h1> Course : "'. 1486: $ENV{'course.'.$ENV{'request.course.id'}. 1487: '.description'}.'"</h1><h2>'.localtime().'</h2>'); 1488: # ------------------------------- This is going to take a while, produce output 1489: $r->rflush(); 1490: } 1491: 1492: 1493: sub CreateForm { 1494: $r->print("\n".'<form name=stat method=post action="/adm/statistics" >'); 1495: my $content = $ENV{'form.sort'}; 1496: if (!($ENV{'form.showcsv'}) && #|| !($ENV{'csv'})) && 1497: ($content eq '' || $content eq 'Return to Menu')) { 1498: my $Ptr = '<h3>'; 1499: $Ptr .= '<input type=submit name=sort value="Problem Stats"/>'; 1500: $Ptr .= '<br><br>'; 1501: $Ptr .= '<input type=submit name=sort value="Problem Analysis"/>'; 1502: $Ptr .= '<br><br>'; 1503: $Ptr .= '<input type=submit name=sort value="Student Assessment"/>'; 1504: $Ptr .= '</h3>'; 1505: $r->print( $Ptr ); 1506: } 1507: else { 1508: &ClassList(); 1509: if ( $content eq 'Student Assessment' || 1510: $content eq 'Create Student Report' ) { 1511: &MapSecOptions(); 1512: &StudentOptions(); 1513: &StudentReport($CurStu,$StuBox{"$CurStu"}); 1514: } 1515: elsif ( $content eq 'Problem Analysis' ) { 1516: &AnalyzeProblem(); 1517: } 1518: else { 1519: &MapSecOptions(); 1520: &PreStatTable(); 1521: } 1522: } 1523: } 1524: 1525: 1526: sub Menu { 1527: &initial(); 1528: # $Apache::lonxml::debug=1; 1529: # &Apache::lonhomework::showhash(%ENV); 1530: # $Apache::lonxml::debug=0; 1531: &Title(); 1532: my $InpStr = $ENV{'form.sort'}; 1533: if ($InpStr=~/^Analyze\_/) { 1534: &ClassList(); 1535: &ShowOpGraph($InpStr,$ENV{'form.interval'}); 1536: } 1537: elsif ( $InpStr eq 'DoDiff Graph' || $InpStr eq '%Wrong Graph' ) { 1538: &GetGraphData($InpStr); 1539: $r->print('<IMG src="/cgi-bin/graph.gif?'.$GData.'" />'); 1540: } 1541: else { 1542: &CreateForm(); 1543: $r->print("\n".'</form>'); 1544: } 1545: $r->print("\n".'</body>'. 1546: "\n".'</html>'); 1547: $r->rflush(); 1548: } 1549: 1550: sub StudentOptions { 1551: my $OpSel5=''; 1552: $CurStu = $ENV{'form.student'}; 1553: if ( $CurStu eq '' ) { 1554: $CurStu = 'All Students'; 1555: $OpSel5 = 'selected'; 1556: } 1557: my $Ptr =''; 1558: # ----------------------------------- Loading the Students Combobox 1559: $Ptr .= '<br><b>Select Student</b>'."\n". 1560: '<select name="student">'."\n". 1561: '<option '.$OpSel5.'>All Students</option>'; 1562: foreach my $key ( sort keys %StuBox ) { 1563: $Ptr .= '<option'; 1564: if ($CurStu eq $key) {$Ptr .= ' selected';} 1565: $Ptr .= '>'.$key."</option>\n"; 1566: } 1567: $Ptr .= '</select>'; 1568: $Ptr .= '<br><input type="submit" name="sort" value="Create Student Report" />'; 1569: $r->print( $Ptr ); 1570: $r->rflush(); 1571: } 1572: 1573: 1574: sub GetStatus { 1575: $OpSel1=''; 1576: $OpSel2=''; 1577: $OpSel3=''; 1578: $OpSel4=''; 1579: 1580: if ( $ENV{'form.order'} eq 'Descending' ) { $OpSel2='selected'; } 1581: else { $OpSel1 = 'selected'; } 1582: 1583: my %myHeader = reverse( %Header ); 1584: $Pos = $myHeader{$ENV{'form.sort'}}; 1585: if ($Pos == 0) { 1586: $OpSel1 = 'selected'; 1587: $ENV{'form.order'}='Ascendig'; 1588: } 1589: 1590: $CurMap = $ENV{'form.maps'}; 1591: if ( $CurMap eq '' ) { 1592: $CurMap = 'All Maps'; 1593: $OpSel3 = 'selected'; 1594: } 1595: $CurSec = $ENV{'form.section'}; 1596: if ( $CurSec eq '' ) { 1597: $CurSec = 'All Sections'; 1598: $OpSel4 = 'selected'; 1599: } 1600: } 1601: 1602: 1603: sub MapSecOptions { 1604: # ----------------------------------- Loading the Maps Combobox 1605: my $Ptr = '<br>'; 1606: $Ptr .= '<input type="submit" name="sort" value="Return to Menu" />'; 1607: $Ptr .= '<br><b> Select Map </b>'."\n". 1608: '<select name="maps">'."\n". 1609: '<option '.$OpSel3.'>All Maps</option>'; 1610: foreach my $key ( sort keys %maps ) { 1611: $Ptr .= '<option'; 1612: if ($CurMap eq $key) {$Ptr .= ' selected';} 1613: $Ptr .= '>'.$key."</option>\n"; 1614: } 1615: $Ptr .= '</select>'; 1616: $Ptr .= ' '; 1617: 1618: # ----------------------------------- Loading the Sections Combobox 1619: $Ptr .= '<br><b>Select Section</b>'."\n". 1620: '<select name="section">'."\n". 1621: '<option '.$OpSel4.'>All Sections</option>'; 1622: foreach my $key ( sort keys %section ) { 1623: $Ptr .= '<option'; 1624: if ($CurSec eq $key) {$Ptr .= ' selected';} 1625: $Ptr .= '>'.$key."</option>"."\n"; 1626: } 1627: $Ptr .= '</select>'."\n"; 1628: 1629: $r->print( $Ptr ); 1630: $r->rflush(); 1631: } 1632: 1633: 1634: # ================================================================ Main Handler 1635: 1636: sub handler { 1637: $r=shift; 1638: 1639: if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { 1640: # ------------------------------------------- Set document type for header only 1641: if ($r->header_only) { 1642: if ($ENV{'browser.mathml'}) { 1643: $r->content_type('text/xml'); 1644: } 1645: else { 1646: $r->content_type('text/html'); 1647: } 1648: $r->send_http_header; 1649: return OK; 1650: } 1651: my $requrl=$r->uri; 1652: # ----------------------------------------------------------------- Tie db file 1653: 1654: undef %hash; 1655: 1656: if ($ENV{'request.course.fn'}) { 1657: my $fn=$ENV{'request.course.fn'}; 1658: if (-e "$fn.db") { 1659: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) { 1660: # ------------------------------------------------------------------- Hash tied 1661: $r->content_type('text/html'); 1662: $r->send_http_header; 1663: &Menu(); 1664: } 1665: else { 1666: $r->content_type('text/html'); 1667: $r->send_http_header; 1668: $r->print('<html><body>Coursemap undefined.</body></html>'); 1669: } 1670: # ------------------------------------------------------------------ Untie hash 1671: unless (untie(%hash)) { 1672: &Apache::lonnet::logthis("<font color=blue>WARNING: ". 1673: "Could not untie coursemap $fn (browse).</font>"); 1674: } 1675: 1676: # -------------------------------------------------------------------- All done 1677: return OK; 1678: # ----------------------------------------------- Errors, hash could no be tied 1679: } 1680: } 1681: else { 1682: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; 1683: return HTTP_NOT_ACCEPTABLE; 1684: } 1685: } 1686: else { 1687: $ENV{'user.error.msg'}= 1688: $r->uri.":vgr:0:0:Cannot view grades for complete course"; 1689: 1690: return HTTP_NOT_ACCEPTABLE; 1691: } 1692: } 1693: 1; 1694: __END__