loncom/interface/statistics/lonproblemstatistics.pm - view

File: [LON-CAPA] / loncom / interface / statistics / lonproblemstatistics.pm
Revision 1.8: download - view: text, annotated - select for diffs
Tue Jul 30 23:08:56 2002 UTC (21 years, 11 months ago) by minaeibi
Branches: MAIN
CVS tags: HEAD

Fixed a bug in making a link to a problem resource in statististics table.

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