loncom/interface/statistics/lonproblemstatistics.pm - view

File: [LON-CAPA] / loncom / interface / statistics / lonproblemstatistics.pm
Revision 1.3: download - view: text, annotated - select for diffs
Fri Jul 26 21:50:12 2002 UTC (21 years, 11 months ago) by minaeibi
Branches: MAIN
CVS tags: HEAD

removed all global variables
Started to work with stats table in new method of caching the student data
PS:(It needs more work)

1: # The LearningOnline Network with CAPA 2: # (Publication Handler 3: # 4: # $Id: lonproblemstatistics.pm,v 1.3 2002/07/26 21:50:12 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,5/19,5/26,7/16,7/25 Behrouz Minaei 35: # 36: ### 37: 38: package Apache::lonproblemstatistics; 39: 40: use strict; 41: use Apache::lonnet(); 42: use Apache::lonhtmlcommon; 43: use Apache::loncoursedata; 44: use GDBM_File; 45: 46: #my %mapsort; 47: 48: sub BuildProblemStatisticsPage { 49: my ($cacheDB, $students, $courseID, $c, $r,%color)=@_; 50: my %cache; 51: #my %DoDiff; 52: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) { 53: return '<html><body>Unable to tie database.</body></html>'; 54: } 55: 56: my $Ptr = ''; 57: $Ptr .= '<table border="0"><tbody>'; 58: $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n"; 59: $Ptr .= '<td align="left">'; 60: $Ptr .= &Apache::lonhtmlcommon::MapOptions(\%cache, 'ProblemStatistics'); 61: $Ptr .= '</td></tr>'."\n"; 62: $Ptr .= &AscendOrderOptions($cache{'Ascend'}); 63: $Ptr .= &ProblemStatisticsButtons($cache{'DisplayFormat'}); 64: $Ptr .= '</table>'; 65: 66: $Ptr .= &ProblemStatisticsLegend(); 67: 68: untie(%cache); 69: foreach (@$students) { 70: my $courseData = 71: &Apache::loncoursedata::DownloadCourseInformation($_, $courseID); 72: last if ($c->aborted()); 73: if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT,0640)) { 74: &Apache::loncoursedata::ProcessStudentData(\%cache, 75: $courseData, $_); 76: untie(%cache); 77: } 78: } 79: if($c->aborted()) { return $Ptr; } 80: 81: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER,0640)) { 82: return '<html><body>Unable to tie database.</body></html>'; 83: } 84: my $discriminantFactor; 85: my @list=(); 86: my %Discuss=&Apache::loncoursedata::LoadDiscussion($courseID); 87: my $index=0; 88: foreach (@$students) { 89: $index++; 90: #&Apache::lonstatistics::Update_PrgWin(++$index,$r); 91: $discriminantFactor = &ExtractStudentData(\%cache, $_, \@list, 92: \%Discuss, $r); 93: } 94: #&Apache::lonstatistics::Close_PrgWin($r); 95: 96: my ($upper, $lower) = &Discriminant($discriminantFactor); 97: my %Header = (0,"Homework Sets Order",1,"#Stdnts",2,"Tries",3,"Mod", 98: 4,"Mean",5,"#YES",6,"#yes",7,"%Wrng",8,"DoDiff", 99: 9,"S.D.",10,"Skew.",11,"D.F.1st",12,"D.F.2nd", 13, "Disc."); 100: 101: my %GraphDat= &BuildStatisticsTable(\%cache, $discriminantFactor, \@list, 102: \%Header, $students, $r, \%color); 103: 104: untie(%cache); 105: 106: return $Ptr; 107: } 108: 109: sub BuildDiffGraph { 110: my ($r)=@_; 111: 112: my $graphData = &GetGraphData('DiffGraph', $r); 113: return '<IMG src="/cgi-bin/graph.gif?'.$graphData.'" />'; 114: } 115: 116: sub BuildWrongGraph { 117: my ($r)=@_; 118: 119: my $graphData = &GetGraphData('WrongGraph', $r); 120: return '<IMG src="/cgi-bin/graph.gif?'.$graphData.'" />'; 121: } 122: 123: #---- Activity log ------------------------------------------------------- 124: 125: sub LoadDoDiffFile { 126: my $file="/home/minaeibi/183d.txt"; 127: open(FILEID, "<$file"); 128: my $line=<FILEID>; 129: my %DoDiff=(); 130: my @Act=split('&',$line); 131: 132: # $r->print('<br>'.$#Act); 133: for(my $n=0;$n<=$#Act;$n++){ 134: my ($res,$Degree)=split('@',$Act[$n]); 135: $DoDiff{$res}=$Degree; 136: } 137: 138: return \%DoDiff; 139: } 140: 141: sub LoadClassFile { 142: my $file="/home/minaeibi/class.txt"; 143: open(FILEID, "<$file"); 144: my $line; 145: my %Grade=(); 146: while ($line=<FILEID>) { 147: my ($id,$ex1,$ex2,$ex3,$ex4,$hw,$final,$grade)=split(' ',$line); 148: $Grade{$id}=$grade; 149: } 150: return \%Grade; 151: } 152: 153: #------- Classification 154: sub Classify { 155: my ($DiscFac, $students)=@_; 156: my ($fileGrade) = &LoadClassFile(); 157: my $Count=0; 158: my @List=(); 159: my @LS=(); 160: my @LF=(); 161: my @LM=(); 162: my $cf=0; 163: my $cs=0; 164: my $cm=0; 165: foreach (keys(%$DiscFac)){ 166: my @l=split(/\:/,$_); 167: if (!($students->{$l[1]})) {next;} 168: my $Grade=$fileGrade->{$students->{$l[1]}}; 169: if( $Grade > 3 ) { 170: $cs++; 171: push(@LS,("$l[6],$l[5],$l[4],$l[7],$l[8],$l[9],Successful")); 172: } elsif ( $Grade > 2 ) { 173: $cm++; 174: push(@LM,("$l[6],$l[5],$l[4],$l[7],$l[8],$l[9],Average")); 175: } else { 176: $cf++; 177: push(@LF,("$l[6],$l[5],$l[4],$l[7],$l[8],$l[9],Failed")); 178: } 179: } 180: my $Str = ''; 181: for(my $n=0;$n<$cs;$n++){$Str .= '<br>'.$LS[$n];} 182: for(my $n=0;$n<$cm;$n++){$Str .= '<br>'.$LM[$n];} 183: for(my $n=0;$n<$cf;$n++){$Str .= '<br>'.$LF[$n];} 184: 185: return $Str; 186: } 187: 188: sub ProcAct { 189: # return; 190: my ($Act,$Submit)=@_; 191: my @Act=split(/\@/,$Act); 192: @Act = sort(@Act); 193: 194: ##$r->print('<br>'.$#Act); 195: ##for(my $n=0;$n<=$#Act;$n++){ 196: ## $r->print('<br>n='.$n.')'.$Act[$n]); 197: ## } 198: 199: # my $Beg=$Act[0]; 200: my $Dif=$Submit-$Act[0]; 201: $Dif = ($Dif>0) ? ($Dif/3600) : 0; 202: 203: # $r->print('<br>Access Number = '.$#Act.'<br>Submit Time='.$Submit.'<br>First Access='.$Act[0].'<br>Last Access='.$Act[$#Act].'<br> Submit - First = <b>'.$Dif.'</b>'); 204: 205: 206: #time spent for solving the problem 207: # $r->print('<br>Def'.($Act[$#Act-1]-$Act[0])); 208: 209: return $Dif; 210: } 211: 212: sub LoadActivityLog { 213: # my $CacheDB = "/home/minaeibi/act183.log.cache"; 214: my $CacheDB = "/home/httpd/perl/tmp/act183.log.cache"; 215: 216: my %Activity; 217: if (-e "$CacheDB") { 218: if (tie(%Activity,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) { 219: return; 220: } 221: else { 222: # $r->print("Unable to tie log Cache hash to db file"); 223: } 224: } 225: else { 226: if (tie(%Activity,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) { 227: foreach (keys %Activity) {delete $Activity{$_};} 228: &Build_log(\%Activity); 229: } 230: else { 231: # $r->print("Unable to tie log Build hash to db file"); 232: } 233: } 234: return \%Activity; 235: } 236: 237: sub Build_log { 238: my ($Activity)=@_; 239: my $file="/home/minaeibi/act183.log"; 240: open(FILEID, "<$file"); 241: my $line; 242: my $count=0; 243: while ($line=<FILEID>) { 244: my ($time,$machine,$what)=split(':',$line); 245: $what=&Apache::lonnet::unescape($what); 246: my @accesses=split('&',$what); 247: 248: foreach my $access (@accesses) { 249: 250: $count++; 251: 252: my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access); 253: if (!$resource) { next; } 254: my $res=&Apache::lonnet::unescape($resource); 255: if (($res =~ /\.problem/)) { 256: $Activity->{$who.':'.$res}.=$date.'@'; 257: #$r->print('<br>'.$time.':'.$who.'---'.$res); 258: &Update_PrgInit($count); 259: 260: } 261: } 262: } 263: 264: # my $c=1; 265: # foreach (sort keys %Activity) { 266: # $r->print('<br>'.$c.')'.$_.' ... '.$Activity{$_}); 267: # $c++; 268: # } 269: 270: } 271: 272: sub Activity { 273: my $file="/home/minaeibi/activity.log"; 274: my $userid='adamsde1'; 275: # $r->print("<br>Using $file"); 276: # $r->rflush(); 277: open(FILEID, "<$file"); 278: my $line; 279: my @allaccess; 280: my $Count=0; 281: while ($line=<FILEID>) { 282: my ($time,$machine,$what)=split(':',$line); 283: $what=&Apache::lonnet::unescape($what); 284: my @accesses=split('&',$what); 285: foreach my $access (@accesses) { 286: my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access); 287: #if ($who ne $userid) { next; } 288: if (!$resource) { next; } 289: my $res=&Apache::lonnet::unescape($resource); 290: if (($res =~ /\.(sequence|problem|htm|html|page)/)) { 291: $Count++; 292: ###888 $r->print("<br>$Count) ".localtime($date).": $who --> $res"); 293: # if ($post) { 294: # $Count++; 295: # $r->print("<br><b>$Count) Sent data ".join(':', 296: # &Apache::lonnet::unescape(@posts)).'</b>'); 297: # } 298: ###888 $r->rflush(); 299: } 300: #push (@allaccess,unescape($access)); 301: #print $machine; 302: } 303: } 304: # @allaccess=sort(@allaccess); 305: # $Count=0; 306: # foreach my $access (@allaccess) { 307: # my ($date,$resource,$who,$domain,$post,@posts)=split(':',$access); 308: # $Count++; 309: # $r->print("<br>$Count) $date: $who --> $resource"); 310: # $r->rflush(); 311: # if ($post) { 312: # $r->print("<br><b>Sent data ".join(':',unescape(@posts)).'</b>'); 313: # } 314: # } 315: } 316: 317: #---- END Activity log --------------------------------------------------- 318: 319: #---- Problem Statistics Web Page --------------------------------------- 320: 321: #------- Processing upperlist and lowerlist according to each problem 322: sub ProcessDiscriminant { 323: my ($List) = @_; 324: my @sortedList = sort (@$List); 325: my $Count = scalar @sortedList; 326: my $Problem; 327: my @Dis; 328: my $Slvd=0; 329: my $tmp; 330: my $Sum1=0; 331: my $Sum2=0; 332: my $nIndex=0; 333: my $nStudent=0; 334: my %Proc=undef; 335: while ($nIndex<$Count) { 336: ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]); 337: @Dis=split(/\+/,$tmp); 338: my $Temp = $Problem; 339: do { 340: $nIndex++; 341: $nStudent++; 342: $Sum1 += $Dis[0]; 343: $Sum2 += $Dis[1]; 344: ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]); 345: @Dis=split(/\+/,$tmp); 346: } while ( $Problem eq $Temp && $nIndex < $Count ); 347: # $Proc{$Temp}=($Sum1/$nStudent).':'.$nStudent; 348: $Proc{$Temp}=($Sum1/$nStudent).':'.($Sum2/$nStudent); 349: # $r->print("$nIndex) $Temp --> ($nStudent) $Proc{$Temp} <br>"); 350: $Sum1=0; 351: $Sum2=0; 352: $nStudent=0; 353: } 354: 355: return %Proc; 356: } 357: 358: #------- Creating Discimination factor 359: sub Discriminant { 360: my ($discriminantFactor)=@_; 361: my @discriminantKeys=keys(%$discriminantFactor); 362: my $Count = scalar @discriminantKeys; 363: 364: my $UpCnt = int(0.27*$Count); 365: my $low=0; 366: my $up=$Count-$UpCnt; 367: my @UpList=(); 368: my @LowList=(); 369: 370: $Count=0; 371: foreach my $key (sort(@discriminantKeys)) { 372: $Count++; 373: if($low < $UpCnt || $Count > $up) { 374: $low++; 375: my $str=$discriminantFactor->{$key}; 376: foreach(split(/\:/,$str)){ 377: if($_) { 378: if($low<$UpCnt) { push(@LowList,$_); } 379: else { push(@UpList,$_); } 380: } 381: } 382: } 383: } 384: my %DisUp = &ProcessDiscriminant(\@UpList); 385: my %DisLow = &ProcessDiscriminant(\@LowList); 386: 387: return (\%DisUp, \%DisLow); 388: } 389: 390: 391: sub NumericSort { 392: $a <=> $b; 393: } 394: 395: 396: sub CreateProblemStatisticsTableHeading { 397: my ($displayFormat,$sequenceSource,$sequenceTitle,$headings,$r)=@_; 398: if($displayFormat eq 'Display CSV Format') { 399: $r->print('<br>"'.$sequenceTitle.'","'); 400: $r->print($sequenceSource.'"'); 401: return; 402: } 403: 404: $r->print('<br><a href="'.$sequenceSource. 405: '" target="_blank">'.$sequenceTitle.'</a>'); 406: 407: my $Result = "\n".'<table border=2><tr><th>P#</th>'."\n"; 408: for(my $nIndex=0; $nIndex < (scalar (keys %$headings)); $nIndex++) { 409: $Result .= '<th>'.'<input type="submit" name="'; 410: $Result .= 'ProblemStatisticsHeading" value="'; 411: $Result .= $headings->{$nIndex}.'" />'.'</th>'."\n"; 412: } 413: $Result .= "\n".'</tr>'."\n"; 414: $r->print($Result); 415: $r->rflush(); 416: } 417: 418: sub CloseTable { 419: my ($cache,$r)=@_; 420: if($cache->{'DisplayFormat'} eq 'Display CSV Format') { 421: return; 422: } 423: $r->print("\n".'</table>'."\n"); 424: $r->rflush(); 425: } 426: 427: 428: 429: # ------ Dump the Student's DB file and handling the data for statistics table 430: sub ExtractStudentData { 431: my ($cache,$name,$list,$Discuss,$r)=@_; 432: my %discriminantFactor; 433: 434: my $totalTries = 0; 435: my $totalAwarded = 0; 436: my $tempProblemOrder=0; 437: my $spent=0; 438: my $spent_yes=0; 439: my $TotDiscuss=0; 440: my $TotalOpend = 0; 441: my $ProbSolved = 0; 442: my $ProbTot = 0; 443: my $TotFirst = 0; 444: my $TimeTot = 0; 445: my $Discussed=0; 446: 447: $Apache::lonxml::debug=1; 448: #&Apache::lonhomework::showhash(%$cache); 449: $Apache::lonxml::debug=0; 450: 451: foreach my $sequence (split(':', $cache->{'orderedSequences'})) { 452: # if($cache->{'ProblemStatisticsMap'} ne 'All Maps' && 453: # $cache->{'ProblemStatisticsMap'} ne $cache->{$sequence.':title'}) { 454: $r->print("<br>$name --- $sequence"); 455: $r->print("<br>".$cache->{$sequence.':title'}); 456: # next; 457: # } 458: 459: my $Dis = ''; 460: foreach my $problemID (split(':', $cache->{$sequence.':problems'})) { 461: my $problem = $cache->{$problemID.':problem'}; 462: $r->print("<br>$problemID === $problem"); 463: my $LatestVersion = $cache->{$name.':version:'.$problem}; 464: # Output dashes for all the parts of this problem if there 465: # is no version information about the current problem. 466: #if(!$LatestVersion) { 467: # foreach my $part (split(/\:/,$cache->{$sequence.':'. 468: # $problemID. 469: # ':parts'})) { 470: # $codes .= "-,"; 471: # $attempts .= "0,"; 472: # } 473: # next; 474: #} 475: 476: my %partData=undef; 477: # Initialize part data, display skips correctly 478: # Skip refers to when a student made no submissions on that 479: # part/problem. 480: foreach my $part (split(/\:/,$cache->{$sequence.':'. 481: $problemID. 482: ':parts'})) { 483: $partData{$part.':tries'}=0; 484: $partData{$part.':code'}='-'; 485: } 486: 487: # Looping through all the versions of each part, starting with the 488: # oldest version. Basically, it gets the most recent 489: # set of grade data for each part. 490: for(my $Version=1; $Version<=$LatestVersion; $Version++) { 491: foreach my $part (split(/\:/,$cache->{$sequence.':'. 492: $problemID. 493: ':parts'})) { 494: 495: if(!defined($cache->{$name.":$Version:$problem". 496: ":resource.$part.solved"})) { 497: # No grade for this submission, so skip 498: next; 499: } 500: 501: my $tries=0; 502: my $time=0; 503: my $awarded=0; 504: $Discussed=0; 505: my $code='U'; 506: 507: $awarded = $cache->{$name. 508: "$Version:$problem:resource.". 509: "$part.awarded"}; 510: $partData{$part.':awarded'} = ($awarded) ? $awarded : 0; 511: $totalAwarded += $awarded; 512: 513: $tries = $cache->{$name.":$Version:$problem". 514: ":resource.$part.tries"}; 515: $partData{$part.':tries'} = ($tries) ? $tries : 0; 516: $partData{$part.':wrong'} = $partData{$part.':tries'}; 517: $totalTries += $tries; 518: 519: my $val = $cache->{$name.":$Version:$problem". 520: ":resource.$part.solved"}; 521: if ($val eq 'correct_by_student') {$code = 'C';} 522: elsif ($val eq 'correct_by_override') {$code = 'O';} 523: elsif ($val eq 'incorrect_attempted') {$code = 'I';} 524: elsif ($val eq 'incorrect_by_override'){$code = 'I';} 525: elsif ($val eq 'excused') {$code = 'x';} 526: $partData{$part.':code'}=$code; 527: if($partData{$part.':wrong'} ne 0 && 528: ($code eq 'C' || $code eq 'O')) { 529: $partData{$part.':wrong'}--; 530: } 531: } 532: } 533: 534: # Loop through all the parts for the current problem in the 535: # correct order and prepare the output 536: foreach (split(/\:/,$cache->{$sequence.':'.$problemID. 537: ':parts'})) { 538: my $Yes = 0; 539: if($partData{$_.':code'} eq 'C' || 540: $partData{$_.':code'} eq 'O') { 541: $Yes=1; 542: } 543: my $ptr = $tempProblemOrder.'&'.$problemID; 544: 545: if($_ > 1) { 546: $ptr .= "*(part $_)"; 547: $Dis .= '&'; 548: } 549: 550: my ($pr_no,$dod)=split('&',$ptr); 551: # my $DoDiff=$DoDiff->{$dod}; 552: # $r->print('<br>'.$name.'---'.$ptr.'==='.$DoDiff); 553: 554: my $Fac = ($partData{$_.':Tries'}) ? 555: ($partData{$_.':awarded'}/$partData{$_.':tries'}) : 0; 556: my $DisF; 557: if($Fac > 0 && $Fac < 1) { 558: $DisF = sprintf( "%.4f", $Fac ); 559: } else { 560: $DisF = $Fac; 561: } 562: 563: if ($Discuss->{"$name:$problem"}) { 564: $TotDiscuss++; 565: $Discussed=1; 566: } 567: my $time = $cache->{"$name:$LatestVersion:$problem:timestamp"}; 568: $Dis .= $tempProblemOrder.'='.$DisF.'+'.$Yes; 569: $ptr .= '&'.$partData{$_.'.tries'}. 570: '&'.$partData{$_.'.wrongs'}. 571: '&'.$partData{$_.'.code'}; 572: push (@$list, $ptr."&$Discussed"); 573: $r->print('<br>'.$name.'---'.$ptr); 574: 575: #### if ($DoDiff>0.85) { 576: 577: $TimeTot += $time; 578: 579: if ($Yes==1 && $partData{$_.'.Tries'}==1) { 580: $TotFirst++; 581: } 582: # my $Acts= $Activity->{$name.':'.$problem}; 583: # if ($Acts) { 584: # my $Pt=&ProcAct( $Acts, $time ); 585: #my ($spe,$beg) = split(/\+/,$Pt); 586: # my $spe= $Pt; 587: # if ($Yes==1) {$spent_yes += $spe;} 588: # $spent += $spe; 589: #$Beg += $beg; 590: # $r->print('<br>'.$name.'---'.$problem.'---'.$spe); 591: # } 592: $TotalOpend++; 593: $ProbTot++; 594: 595: $tempProblemOrder++; 596: } 597: } 598: my $pstr; 599: if($totalTries) { 600: my $DisFac = ($totalAwarded/$totalTries); 601: my $DisFactor = sprintf( "%.4f", $DisFac ); 602: my $TS = sprintf( "%.2f", $spent ); 603: my $TS_yes = sprintf( "%.2f", $spent_yes ); 604: # $DiscFac{$DisFactor}=$Dis; 605: $pstr=$DisFactor.':'.$name.':'.$ProbTot.':'.$TotalOpend.':'. 606: $totalTries.':'.$ProbSolved.':'.$TotFirst.':'. 607: $TS_yes.':'.$TS.':'.$TotDiscuss; 608: $discriminantFactor{$pstr}=$Dis; 609: } 610: } 611: 612: return (\%discriminantFactor); 613: } 614: 615: 616: =pod 617: sub MySort { 618: if ( $Pos > 0 ) { 619: if ($ENV{'form.order'} eq 'Descending') {$b <=> $a;} 620: else { $a <=> $b; } 621: } 622: else { 623: if ($ENV{'form.order'} eq 'Descending') {$b cmp $a;} 624: else { $a cmp $b; } 625: } 626: } 627: =cut 628: 629: 630: sub BuildStatisticsTable { 631: my ($cache,$discriminantFactor,$list,$headings,$students,$r,%color)=@_; 632: 633: #6666666 634: # my $file="/home/httpd/perl/tmp/183d.txt"; 635: # open(OUT, ">$file"); 636: #6666666 637: ## &Apache::lonstatistics::Create_PrgWin($r); 638: ##777777 639: ## my (%Activity) = &LoadActivityLog(); 640: ## $r->print('<script>popwin.document.popremain.remaining.value="'. 641: ## 'Loading Discussion...";</script>'); 642: ## my ($doDiffFile) = &LoadDoDiffFile(); 643: 644: my $p_count = 0; 645: my $nIndex = 0; 646: my $dummy; 647: my $p_val; 648: my $ResId; 649: my %GraphDat; 650: my $NoElements = scalar @$list; 651: 652: 653: foreach my $sequence (split(':', $cache->{'orderedSequences'})) { 654: 655: &CreateProblemStatisticsTableHeading($cache->{'DisplayFormat'}, 656: $cache->{$sequence.':source'}, 657: $cache->{$sequence.':title'}, 658: $headings,$r); 659: 660: foreach my $problemID (split(':', $cache->{$sequence.':problems'})) { 661: my $problem = $cache->{$problemID.':problem'}; 662: $r->print("<br>$problem"); 663: 664: } 665: } 666: } 667: =pod 668: ##777777 669: ## $Str .= &Classify($discriminantFactor, $students); 670: 671: 672: my ($Hid,$pr)=split(/\:/,$mapsort{$_}); 673: my @lpr=split(/\&/,$pr); 674: for (my $i=1; $i<=$#lpr; $i++) { 675: my %storestats=(); 676: my ($PrOrd,$Prob,$Tries,$Wrongs,$Code,$Disc)=split(/\&/,$list->[$nIndex]); 677: my $Temp = $Prob; 678: my $MxTries = 0; 679: my $TotalTries = 0; 680: my $YES = 0; 681: my $Incorrect = 0; 682: my $Override = 0; 683: my $StdNo = 0; 684: my $DiscNo=0; 685: my @StdLst; 686: while ( $PrOrd == $lpr[$i] ) 687: { 688: $nIndex++; 689: $StdNo++; 690: $StdLst[ $StdNo ] = $Tries; 691: $TotalTries += $Tries; 692: if ( $MxTries < $Tries ) { $MxTries = $Tries; } 693: if ( $Code eq 'C' ){ $YES++; } 694: elsif( $Code eq 'I' ) { $Incorrect++; } 695: elsif( $Code eq 'O' ) { $Override++; } 696: elsif( $Code eq 'U' ) { $StdNo--; } 697: ($PrOrd,$Prob,$Tries,$Wrongs,$Code,$Disc)=split(/\&/,$list->[$nIndex]); 698: } 699: 700: $p_count++; 701: my $Dummy; 702: ($ResId,$Dummy)=split(/\*/,$Temp); 703: 704: $Temp = '<a href="'.$cache->{'src_'.$ResId}. 705: '" target="_blank">'.$cache->{'title_'.$ResId}.$Dummy.'</a>'; 706: 707: my $res = &Apache::lonnet::declutter($cache->{'src_'.$ResId}); 708: my $urlres=$res; 709: 710: $ResId=~/(\d+)\.(\d+)/; 711: my $Map = &Apache::lonnet::declutter( $cache->{'map_id_'.$1} ); 712: $urlres=$Map; 713: 714: $res = '<a href="'.$cache->{'src_'.$ResId}.'">'.$res.'</a>'; 715: #$Map = '<a href="'.$Map.'">'.$res.'</a>'; 716: 717: #------------------------ Compute the Average of Tries about one problem 718: my $Average = ($StdNo) ? $TotalTries/$StdNo : 0; 719: 720: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___timestamp'}=time; 721: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___stdno'}=$StdNo; 722: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___avetries'}=$Average; 723: 724: #-------------------------------- Compute percentage of Wrong tries 725: my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0; 726: 727: #-------------------------------- Compute Standard Deviation 728: my $StdDev = 0; 729: if ( $StdNo > 1 ) { 730: for ( my $n = 0; $n < $StdNo; $n++ ) { 731: my $Dif = $StdLst[ $n ]-$Average; 732: $StdDev += $Dif*$Dif; 733: } 734: $StdDev /= ( $StdNo - 1 ); 735: $StdDev = sqrt( $StdDev ); 736: } 737: 738: #-------------------------------- Compute Degree of Difficulty 739: my $DoDiff = 0; 740: if( $TotalTries > 0 ) { 741: $DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries ); 742: # $DoDiff = ($TotalTries)/($YES + $Override+ 0.1); 743: } 744: 745: $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff; 746: 747: #-------------------------------- Compute the Skewness 748: my $Skewness = 0; 749: my $Sum = 0; 750: if ( $StdNo > 0 && $StdDev > 0 ) { 751: for ( my $n = 0; $n < $StdNo; $n++ ) { 752: my $Dif = $StdLst[ $n ]-$Average; 753: $Skewness += $Dif*$Dif*$Dif; 754: } 755: $Skewness /= $StdNo; 756: $Skewness /= $StdDev*$StdDev*$StdDev; 757: } 758: 759: #--------------------- Compute the Discrimination Factors 760: my ($Up1,$Up2)=split(/\:/,':');#jason$DisUp->{$lpr[$i]}); 761: my ($Lw1,$Lw2)=split(/\:/,':');#jason$DisLow->{$lpr[$i]}); 762: my $Dis1 = $Up1 - $Lw1; 763: my $Dis2 = $Up2 - $Lw2; 764: my $_D1 = sprintf("%.2f", $Dis1); 765: my $_D2 = sprintf("%.2f", $Dis2); 766: 767: #----------------- Some restition in presenting the float numbers 768: my $Avg = sprintf( "%.2f", $Average ); 769: my $Wrng = sprintf( "%.1f", $Wrong ); 770: my $SD = sprintf( "%.1f", $StdDev ); 771: my $DoD = sprintf( "%.2f", $DoDiff ); 772: my $Sk = sprintf( "%.1f", $Skewness ); 773: my $join = $lpr[$i].'&'.$Temp.'&'.$StdNo.'&'. 774: $TotalTries.'&'.$MxTries.'&'.$Avg.'&'. 775: $YES.'&'.$Override.'&'.$Wrng.'&'.$DoD.'&'. 776: $SD.'&'.$Sk.'&'.$_D1.'&'.$_D2.'&'. 777: $DiscNo.'&'.$Prob; 778: ##8888 $CachData{($p_count-1)}=$join; 779: 780: #6666666 781: # $r->print('<br>'.$out.'&'.$DoD); 782: # print (OUT $out.'@'.$DoD.'&'); 783: #6666666 784: 785: $urlres=~/^(\w+)\/(\w+)/; 786: if ($StdNo) { 787: &Apache::lonnet::put('resevaldata',\%storestats,$1,$2); 788: } 789: #-------------------------------- Row of statistical table 790: &TableRow($cache,$join,$i,($p_count-1),$r,\%color,\%GraphDat); 791: } 792: &CloseTable($cache,$r); 793: } 794: &Close_PrgWin(); 795: #666666 796: # close( OUT ); 797: #666666 798: } 799: =cut 800: 801: =pod 802: sub Cache_Statistics { 803: my ($cache,$color)=@_; 804: my @list = (); 805: my $Useful; 806: my $UnUseful; 807: # $r->print('<input type="hidden" name="show" value="excel" />'."\n"); 808: my %myHeader = reverse( %Header ); 809: $Pos = $myHeader{$ENV{'form.sort'}}; 810: if ($Pos > 0) {$Pos++;} 811: my $p_count = 0; 812: foreach my $key( keys %CachData) { 813: my @Temp=split(/\&/,$CachData{$key}); 814: if ( $Pos == 0 ) { 815: ($UnUseful,$Useful)=split(/\>/,$Temp[$Pos]); 816: } 817: else { 818: $Useful = $Temp[$Pos]; 819: } 820: $list[$p_count]=$Useful.'@'.$CachData{$key}; 821: $p_count++; 822: } 823: 824: @list = sort MySort (@list); 825: 826: my $nIndex=0; 827: 828: if ( $Pos == 0 ) { 829: foreach (sort keys %mapsort) { 830: my ($Hid,$pr)=split(/\:/,$mapsort{$_}); 831: &CreateProblemStatisticsTableHeading($cache,1,$Hid); 832: my @lpr=split(/\&/,$pr); 833: for (my $i=1; $i<=$#lpr; $i++) { 834: my($Pre, $Post) = split(/\@/,$list[$nIndex]); 835: #$r->print('<br>'.$Pre.'---'.$Post); 836: &TableRow($cache,$Post,$i,$nIndex,\%color,\%GraphDat); 837: $nIndex++; 838: } 839: &CloseTable($cache); 840: } 841: } 842: else { 843: &CreateProblemStatisticsTableHeading($cache,0); 844: for ( my $nIndex = 0; $nIndex < $p_count; $nIndex++ ) { 845: my($Pre, $Post) = split(/\@/,$list[$nIndex]); 846: &TableRow($cache,$Post,$nIndex,$nIndex,\%color,\%GraphDat); 847: } 848: &CloseTable($cache); 849: } 850: } 851: =cut 852: 853: sub TableRow { 854: my ($cache,$Str,$Idx,$RealIdx,$r,$color,$GraphDat)=@_; 855: my($PrOrd,$Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override, 856: $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$DiscNo,$Prob)=split(/\&/,$Str); 857: if ($ENV{'form.showcsv'}) { 858: my ($ResId,$Dummy)=split(/\*/,$Prob); 859: my $Ptr = "\n".'<br>'. 860: "\n".'"'.($RealIdx+1).'",'. 861: "\n".'"'.$cache->{'title_'.$ResId}.$Dummy.'",'. 862: "\n".'"'.$cache->{'src_'.$ResId}.'",'. 863: "\n".'"'.$StdNo.'",'. 864: "\n".'"'.$TotalTries.'",'. 865: "\n".'"'.$MxTries.'",'. 866: "\n".'"'.$Avg.'",'. 867: "\n".'"'.$YES.'",'. 868: "\n".'"'.$Override.'",'. 869: "\n".'"'.$Wrng.'",'. 870: "\n".'"'.$DoD.'",'. 871: "\n".'"'.$SD.'",'. 872: "\n".'"'.$Sk.'",'. 873: "\n".'"'.$_D1.'",'. 874: "\n".'"'.$_D2.'"'. 875: "\n".'"'.$DiscNo.'"'; 876: 877: $r->print("\n".$Ptr); 878: } 879: else{ 880: my $Ptr = "\n".'<tr>'. 881: "\n".'<td>'.($RealIdx+1).'</td>'. 882: # "\n".'<td>'.$PrOrd.$Temp.'</td>'. 883: "\n".'<td>'.$Temp.'</td>'. 884: "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$StdNo.'</td>'. 885: "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$TotalTries.'</td>'. 886: "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$MxTries.'</td>'. 887: "\n".'<td bgcolor='.$color->{"gb"}.'>'.$Avg.'</td>'. 888: "\n".'<td bgcolor='.$color->{"gb"}.'> '.$YES.'</td>'. 889: "\n".'<td bgcolor='.$color->{"gb"}.'> '.$Override.'</td>'. 890: "\n".'<td bgcolor='.$color->{"red"}.'> '.$Wrng.'</td>'. 891: "\n".'<td bgcolor='.$color->{"red"}.'> '.$DoD.'</td>'. 892: "\n".'<td bgcolor='.$color->{"green"}.'> '.$SD.'</td>'. 893: "\n".'<td bgcolor='.$color->{"green"}.'> '.$Sk.'</td>'. 894: "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D1.'</td>'. 895: "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D2.'</td>'. 896: "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$DiscNo.'</td>'; 897: $r->print("\n".$Ptr.'</tr>' ); 898: } 899: $GraphDat->{$RealIdx}=$DoD.':'.$Wrng; 900: } 901: 902: sub StatusOptions { 903: my ($cache)=@_; 904: 905: my $Status = $cache->{'Status'}; 906: my $OpSel1 = ''; 907: my $OpSel2 = ''; 908: my $OpSel3 = ''; 909: 910: if($Status eq 'Any') { $OpSel3 = ' selected'; } 911: elsif($Status eq 'Expired' ) { $OpSel2 = ' selected'; } 912: else { $OpSel1 = ' selected'; } 913: 914: my $Ptr = ''; 915: $Ptr .= '<tr><td align="right"><b>Student Status:</b></td>'."\n"; 916: $Ptr .= '<td align="left"><select name="Status">'; 917: $Ptr .= '<option'.$OpSel1.'>Active</option>'."\n"; 918: $Ptr .= '<option'.$OpSel2.'>Expired</option>'."\n"; 919: $Ptr .= '<option'.$OpSel3.'>Any</option>'."\n"; 920: $Ptr .= '</select></td></tr>'."\n"; 921: 922: return $Ptr; 923: } 924: 925: sub AscendOrderOptions { 926: my ($order)=@_; 927: 928: my $OpSel1 = ''; 929: my $OpSel2 = ''; 930: 931: if($order eq 'Ascending') { 932: $OpSel1 = ' selected'; 933: } else { 934: $OpSel2 = ' selected'; 935: } 936: 937: my $Ptr = ''; 938: $Ptr .= '<tr><td align="right"><b>Sorting Type:</b></td>'."\n"; 939: $Ptr .= '<td align="left"><select name="Ascend">'."\n"; 940: $Ptr .= '<option'.$OpSel1.'>Ascending</option>'."\n". 941: '<option'.$OpSel2.'>Descending</option>'."\n"; 942: $Ptr .= '</select></td></tr>'."\n"; 943: 944: return $Ptr; 945: } 946: 947: sub ProblemStatisticsButtons { 948: my ($displayFormat)=@_; 949: 950: my $Ptr = '<tr><td></td><td align="left">'; 951: $Ptr .= '<input type=submit name="ProblemStatisticsRecalculate" '; 952: $Ptr .= 'value="Recalculate Statistics"/>'."\n"; 953: $Ptr .= '   '; 954: $Ptr .= '<input type="submit" name="DoDiffGraph" '; 955: $Ptr .= 'value="DoDiff Graph" />'."\n"; 956: $Ptr .= '   '; 957: $Ptr .= '<input type="submit" name="PercentWrongGraph" '; 958: $Ptr .= 'value="%Wrong Graph" />'."\n"; 959: $Ptr .= '   '; 960: $Ptr .= '<input type="submit" name="DisplayCSVFormat" '; 961: if($displayFormat eq 'Display CSV Format') { 962: $Ptr .= 'value="Display CSV Format" />'."\n"; 963: } else { 964: $Ptr .= 'value="Display Table Format" />'."\n"; 965: } 966: $Ptr .= '</td></tr>'; 967: 968: return $Ptr; 969: } 970: 971: sub ProblemStatisticsLegend { 972: my $Ptr = ''; 973: $Ptr = '<table border="0">'; 974: $Ptr .= '<tr><td>'; 975: $Ptr .= '<b>#Stdnts</b>:</td>'; 976: $Ptr .= '<td>Total Number of Students opened the problem.'; 977: $Ptr .= '</td></tr><tr><td>'; 978: $Ptr .= '<b>Tries</b>:</td>'; 979: $Ptr .= '<td>Total Number of Tries for solving the problem.'; 980: $Ptr .= '</td></tr><tr><td>'; 981: $Ptr .= '<b>Mod</b>:</td>'; 982: $Ptr .= '<td>Maximunm Number of Tries for solving the problem.'; 983: $Ptr .= '</td></tr><tr><td>'; 984: $Ptr .= '<b>Mean</b>:</td>'; 985: $Ptr .= '<td>Average Number of the tries. [ Tries / #Stdnts ]'; 986: $Ptr .= '</td></tr><tr><td>'; 987: $Ptr .= '<b>#YES</b>:</td>'; 988: $Ptr .= '<td>Number of students solved the problem correctly.'; 989: $Ptr .= '</td></tr><tr><td>'; 990: $Ptr .= '<b>#yes</b>:</td>'; 991: $Ptr .= '<td>Number of students solved the problem by override.'; 992: $Ptr .= '</td></tr><tr><td>'; 993: $Ptr .= '<b>%Wrng</b>:</td>'; 994: $Ptr .= '<td>Percentage of students tried to solve the problem '; 995: $Ptr .= 'but still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]'; 996: $Ptr .= '</td></tr><tr><td>'; 997: $Ptr .= '<b>DoDiff</b>:</td>'; 998: $Ptr .= '<td>Degree of Difficulty of the problem. '; 999: $Ptr .= '[ 1 - ((#YES+#yes) / Tries) ]'; 1000: $Ptr .= '</td></tr><tr><td>'; 1001: $Ptr .= '<b>S.D.</b>:</td>'; 1002: $Ptr .= '<td>Standard Deviation of the tries. '; 1003: $Ptr .= '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) '; 1004: $Ptr .= 'where Xi denotes every student\'s tries ]'; 1005: $Ptr .= '</td></tr><tr><td>'; 1006: $Ptr .= '<b>Skew.</b>:</td>'; 1007: $Ptr .= '<td>Skewness of the students tries.'; 1008: $Ptr .= '[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]'; 1009: $Ptr .= '</td></tr><tr><td>'; 1010: $Ptr .= '<b>Dis.F.</b>:</td>'; 1011: $Ptr .= '<td>Discrimination Factor: A Standard for evaluating the '; 1012: $Ptr .= 'problem according to a Criterion<br>'; 1013: $Ptr .= '<b>[Applied Criterion in %27 Upper Students - '; 1014: $Ptr .= 'Applied the same Criterion in %27 Lower Students]</b><br>'; 1015: $Ptr .= '<b>1st Criterion</b> for Sorting the Students: '; 1016: $Ptr .= '<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>'; 1017: $Ptr .= '<b>2nd Criterion</b> for Sorting the Students: '; 1018: $Ptr .= '<b>Total number of Correct Answers / Total Number of Tries</b>'; 1019: $Ptr .= '</td></tr>'; 1020: $Ptr .= '<tr><td><b>Disc.</b></td>'; 1021: $Ptr .= '<td>Number of Students had at least one discussion.'; 1022: $Ptr .= '</td></tr></table>'; 1023: 1024: return $Ptr; 1025: } 1026: 1027: #---- END Problem Statistics Web Page ---------------------------------------- 1028: 1029: #---- Problem Statistics Graph Web Page -------------------------------------- 1030: 1031: # ------------------------------------------- Prepare data for Graphical chart 1032: 1033: sub GetGraphData { 1034: my ($ylab,$r,%GraphDat)=@_; 1035: my $Col; 1036: my $data=''; 1037: my $count = 0; 1038: my $Max = 0; 1039: my $cid=$ENV{'request.course.id'}; 1040: my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". 1041: "_$ENV{'user.domain'}_$cid\_graph.db"; 1042: foreach (keys %GraphDat) {delete $GraphDat{$_};} 1043: if (-e "$GraphDB") { 1044: if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) { 1045: if ( $ylab eq 'DoDiff Graph' ) { 1046: $ylab = 'Degree-of-Difficulty'; 1047: $Col = 0; 1048: } 1049: else { 1050: $ylab = 'Wrong-Percentage'; 1051: $Col = 1; 1052: } 1053: foreach (sort NumericSort keys %GraphDat) { 1054: my @Temp=split(/\:/,$GraphDat{$_}); 1055: my $inf = $Temp[$Col]; 1056: if ( $Max < $inf ) {$Max = $inf;} 1057: $data .= $inf.','; 1058: $count++; 1059: } 1060: if ( $Max > 1 ) { 1061: $Max += (10 - $Max % 10); 1062: $Max = int($Max); 1063: } 1064: else { $Max = 1; } 1065: untie(%GraphDat); 1066: my $Course = $ENV{'course.'.$cid.'.description'}; 1067: $Course =~ s/\ /"_"/eg; 1068: my $GData=$Course.'&'.'Problems'.'&'.$ylab.'&'. 1069: $Max.'&'.$count.'&'.$data; 1070: } 1071: else { 1072: $r->print("Unable to tie hash to db file"); 1073: } 1074: } 1075: } 1076: 1; 1077: __END__