loncom/interface/statistics/lonproblemanalysis.pm - view

File: [LON-CAPA] / loncom / interface / statistics / lonproblemanalysis.pm
Revision 1.19: download - view: text, annotated - select for diffs
Tue Feb 25 20:47:47 2003 UTC (21 years, 4 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

lonstatistics.pm:
   POD cleanups
   @SelectedSections is set when we read the classlist.
   Added variables $top_map, @Sequences, and @Assessments.  These are
      initialized by &PrepareCourseData($r).
   Added &PrepareCourseData($r) which is essentially a wrapper for
      &Apache::loncoursedata::get_sequence_assessment_data().
   Added &MapSelect() to output a <select> box for sequences.  Not tested.
   Added &SectionSelect(..) to output a <select> box for sections.  Tested.
   Added &DisplayClasslist($r) which displays a table of the current classlist
      that is sortable by each column.  Does not bother with 'update time' as
      this should not be an issue for the user.  Tested.
   Added call to &PrepareCourseData by the handler.
lonpercentage.pm, lonproblemanalysis.pm, lonproblemstatistics.pm,
lonstudentassessment.pm: modified to call &Apache::lonstatistics::SectionSelect
   instead of the method in lonhtmlcommon.pm.

1: # The LearningOnline Network with CAPA 2: # 3: # $Id: lonproblemanalysis.pm,v 1.19 2003/02/25 20:47:47 matthew Exp $ 4: # 5: # Copyright Michigan State University Board of Trustees 6: # 7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 8: # 9: # LON-CAPA is free software; you can redistribute it and/or modify 10: # it under the terms of the GNU General Public License as published by 11: # the Free Software Foundation; either version 2 of the License, or 12: # (at your option) any later version. 13: # 14: # LON-CAPA is distributed in the hope that it will be useful, 15: # but WITHOUT ANY WARRANTY; without even the implied warranty of 16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17: # GNU General Public License for more details. 18: # 19: # You should have received a copy of the GNU General Public License 20: # along with LON-CAPA; if not, write to the Free Software 21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 22: # 23: # /home/httpd/html/adm/gpl.txt 24: # 25: # http://www.lon-capa.org/ 26: # 27: # (Navigate problems for statistical reports 28: # YEAR=2002 29: # 5/12,7/26,9/7,11/22 Behrouz Minaei 30: # 31: ### 32: 33: package Apache::lonproblemanalysis; 34: 35: use strict; 36: use Apache::lonnet(); 37: use Apache::lonhtmlcommon(); 38: use GDBM_File; 39: 40: my $jr; 41: 42: sub BuildProblemAnalysisPage { 43: my ($cacheDB, $r)=@_; 44: 45: my %cache; 46: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { 47: $r->print('Unable to tie database.'); 48: return; 49: } 50: 51: my $Ptr = ''; 52: $Ptr .= '<table border="0"><tbody>'; 53: $Ptr .= '<tr><td align="right"><b>Select Sections</b>'; 54: $Ptr .= '</td>'."\n"; 55: $Ptr .= '<td align="left">'."\n"; 56: my @sectionsSelected = split(':',$cache{'sectionsSelected'}); 57: my @sections = split(':',$cache{'sectionList'}); 58: $Ptr .= &Apache::lonstatistics::SectionSelect('Section','multiple',5); 59: $Ptr .= '</td></tr>'."\n"; 60: $Ptr .= '<tr><td align="right"><b>Intervals</b></td>'."\n"; 61: $Ptr .= '<td align="left">'; 62: $Ptr .= &IntervalOptions($cache{'Interval'}); 63: $Ptr .= '</td></tr></table><br>'; 64: $r->print($Ptr); 65: $r->rflush(); 66: # $r->print($cache{'OptionResponses'}.'<br>'); 67: $r->print(&OptionResponseTable($cache{'OptionResponses'}, \%cache, $r)); 68: 69: untie(%cache); 70: 71: return; 72: } 73: 74: sub BuildAnalyzePage { 75: my ($cacheDB, $students, $courseID,$r)=@_; 76: 77: $jr = $r; 78: my $c = $r->connection; 79: 80: my $Str = '</form>'; 81: my %cache; 82: 83: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { 84: $Str .= 'Unable to tie database.'; 85: $r->print($Str); 86: return; 87: } 88: 89: # Remove students who don't have the proper section. 90: my @sectionsSelected = split(':',$cache{'sectionsSelected'}); 91: 92: my $studentCount = scalar @$students; 93: for(my $studentIndex=$studentCount-1; $studentIndex>=0; 94: $studentIndex--) { 95: my $value = $cache{$students->[$studentIndex].':section'}; 96: my $found = 0; 97: foreach (@sectionsSelected) { 98: if($_ eq 'none') { 99: if($value eq '' || !defined($value) || $value eq ' ') { 100: $found = 1; 101: last; 102: } 103: } else { 104: if($value eq $_) { 105: $found = 1; 106: last; 107: } 108: } 109: } 110: if($found == 0) { 111: splice(@$students, $studentIndex, 1); 112: } 113: } 114: unless(untie(%cache)) { 115: $r->print('Can not untie hash.'); 116: $r->rflush(); 117: } 118: 119: &Apache::lonhtmlcommon::Close_PrgWin($r); 120: 121: ### jason code for checing is there data in cache 122: # my $error = 123: # &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students, 124: # 'true', 125: # $cacheDB, 126: # 'true', 127: # 'true', 128: # $courseID, 129: # $r, $c); 130: # if($error ne 'OK') { 131: # $r->print($error.'<br>Error downloading course data<br>'); 132: # return; 133: # } 134: 135: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) { 136: $Str .= 'Unable to tie database.'; 137: $r->print($Str); 138: return; 139: } 140: 141: my ($problemId, $part, $responseId)=split(':',$cache{'AnalyzeInfo'}); 142: my $uri = $cache{$problemId.':source'}; 143: my $problem = $cache{$problemId.':problem'}; 144: my $title = $cache{$problemId.':title'}; 145: my $interval = $cache{'Interval'}; 146: my $heading = 'Restore this particular Option Response Problem '. 147: 'Results, Please wait...'; 148: 149: my %ConceptData; 150: $ConceptData{"Interval"} = $interval; 151: 152: #Initialize the option response true answers 153: my ($analyzeData) = &InitAnalysis($uri, $part, $responseId, $problem, 154: $students->[0], $courseID); 155: if(defined($analyzeData->{'error'})) { 156: $Str .= $analyzeData->{'error'}.'<br>Incorrect part requested.<br>'; 157: $r->print($Str); 158: return; 159: } 160: 161: $r->print($Str); 162: $Str = ''; 163: if($c->aborted()) { untie(%cache); return; } 164: 165: #compute the intervals 166: &Interval($part, $problem, $interval, $analyzeData->{'concepts'}, 167: \%ConceptData); 168: 169: $title =~ s/\ /"_"/eg; 170: $Str .= '<br><b>'.$uri.'</b>'; 171: 172: $r->print($Str); 173: $Str = ''; 174: if($c->aborted()) { untie(%cache); return; } 175: 176: &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading); 177: 178: my $count=0; 179: #Java script Progress window 180: for(my $index=0; $index<(scalar @$students); $index++) { 181: if($c->aborted()) { untie(%cache); return; } 182: $count++; 183: my $displayString = $count.'/'.$studentCount.': '.$_; 184: &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r); 185: &OpStatus($problemId, $students->[$index], \%ConceptData, 186: $analyzeData->{'foil_to_concept'}, $analyzeData, 187: \%cache, $courseID); 188: } 189: &Apache::lonhtmlcommon::Close_PrgWin($r); 190: 191: $Str .= '<br>'; 192: for (my $k=0; $k<$interval; $k++ ) { 193: if($c->aborted()) { untie(%cache); return $Str; } 194: $Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'}, 195: \%ConceptData); 196: $r->print($Str); 197: $Str = ''; 198: } 199: for (my $k=0; $k<$interval; $k++ ) { 200: if($c->aborted()) { untie(%cache); return $Str; } 201: $Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData); 202: $r->print($Str); 203: $Str = ''; 204: } 205: my $Answ=&Apache::lonnet::ssi($uri); 206: $Str .= '<br><b>Here you can see the Problem:</b><br>'.$Answ; 207: $Str .= '<form>'; 208: $r->print($Str); 209: 210: untie(%cache); 211: 212: return; 213: } 214: 215: #---- Problem Analysis Web Page ---------------------------------------------- 216: 217: sub IntervalOptions { 218: my ($selectedInterval)=@_; 219: 220: my $interval = 1; 221: for(my $n=1; $n<=7; $n++) { 222: if($selectedInterval == $n) { 223: $interval = $n; 224: } 225: } 226: 227: my $Ptr = '<select name="Interval">'."\n"; 228: for(my $n=1; $n<=7;$ n++) { 229: $Ptr .= '<option'; 230: if($interval == $n) { 231: $Ptr .= ' selected'; 232: } 233: $Ptr .= '>'.$n."</option>"."\n"; 234: } 235: $Ptr .= '</select>'."\n"; 236: 237: return $Ptr; 238: } 239: 240: sub OptionResponseTable { 241: my ($optionResponses,$cache,$r)=@_; 242: 243: my @optionResponses=split(':::', $optionResponses); 244: my %partCount; 245: my %sequences; 246: my @orderedSequences=(); 247: foreach(@optionResponses) { 248: my ($sequence, $problemId, $part, undef)=split(':',$_); 249: $partCount{$problemId.':'.$part}++; 250: if(!defined($sequences{$sequence})) { 251: push(@orderedSequences, $sequence); 252: $sequences{$sequence} = $_; 253: } else { 254: $sequences{$sequence} .= ':::'.$_; 255: } 256: } 257: 258: my $Str = ''; 259: 260: foreach my $sequence (@orderedSequences) { 261: my @optionProblems = split(':::', $sequences{$sequence}); 262: 263: $Str .= '<b>'.$cache->{$sequence.':title'}.'</b>'."\n"; 264: $Str .= "<table border=2><tr><th> \# </th><th> Problem Title </th>"; 265: $Str .= '<th> Resource </th><th> Analysis </th></tr>'."\n"; 266: 267: my $count = 1; 268: foreach(@optionProblems) { 269: my (undef, $problemId, $part, $response)= 270: split(':',$optionProblems[$count-1]); 271: # split(':',$sequences{$sequence}); 272: my $uri = $cache->{$problemId.':source'}; 273: my $title = $cache->{$problemId.':title'}; 274: 275: my $Temp = '<a href="'.$uri.'" target="_blank">'.$title.'</a>'; 276: $Str .= '<tr>'; 277: $Str .= '<td> '.$count.' </td>'; 278: $Str .= '<td bgcolor="#DDFFDD">'.$Temp.'</td>'; 279: $Str .= '<td bgcolor="#EEFFCC">'.$uri.'</td>'; 280: if($partCount{$problemId.':'.$part} < 2) { 281: $Str .= '<td><input type="submit" name="Analyze:::'; 282: $Str .= $problemId.':'.$part.'" value="'; 283: $Str .= 'Part '.$part; 284: $Str .= '" /></td></tr>'."\n"; 285: } else { 286: my $value = $problemId.':'.$part.':'.$response; 287: $Str .= '<td><input type="submit" name="Analyze:::'.$value; 288: $Str .= '" value="'; 289: $Str .= 'Part '.$part.' Response '.$response; 290: $Str .= '" /></td></tr>'."\n"; 291: } 292: $count++; 293: } 294: $Str .= '</table><br>'."\n"; 295: } 296: 297: return $Str; 298: } 299: 300: #---- END Problem Analysis Web Page ------------------------------------------ 301: 302: #---- Analyze Web Page ------------------------------------------------------- 303: 304: # Joson code for reading data from cache 305: =pod 306: sub OpStatus { 307: my ($problemID, $student, $ConceptData, $foil_to_concept, 308: $analyzeData, $cache)=@_; 309: 310: my $ids = $analyzeData->{'parts'}; 311: 312: my @True = (); 313: my @False = (); 314: my $flag=0; 315: 316: my $tries=0; 317: 318: foreach my $id (@$ids) { 319: my ($part, $response) = split(/\./, $id); 320: my $time=$cache->{$student.':'.$problemID.':'.$part.':timestamp'}; 321: my @submissions = split(':::', $cache->{$student.':'.$problemID.':'. 322: $part.':'.$response. 323: ':submission'}); 324: foreach my $Resp (@submissions) { 325: my %submission=&Apache::lonnet::str2hash($Resp); 326: foreach (keys(%submission)) { 327: if($submission{$_}) { 328: my $answer = $analyzeData->{$id.'.foil.value.'.$_}; 329: if($submission{$_} eq $answer) { 330: &Decide("true", $foil_to_concept->{$_}, 331: $time, $ConceptData); 332: } else { 333: &Decide("false", $foil_to_concept->{$_}, 334: $time, $ConceptData); 335: } 336: } 337: } 338: } 339: } 340: 341: return; 342: } 343: =cut 344: 345: 346: #restore the student submissions and finding the result 347: 348: sub OpStatus { 349: my ($problemID, $student, $ConceptData, $foil_to_concept, 350: $analyzeData, $cache, $courseID)=@_; 351: 352: my $ids = $analyzeData->{'parts'}; 353: my ($uname,$udom)=split(/\:/,$student); 354: my $symb = $cache->{$problemID.':problem'}; 355: 356: my @True = (); 357: my @False = (); 358: my $flag=0; 359: my $tries=0; 360: 361: foreach my $id (@$ids) { 362: my ($part, $response) = split(/\./, $id); 363: my %reshash=&Apache::lonnet::restore($symb,$courseID,$udom,$uname); 364: if ($reshash{'version'}) { 365: my $tries=0; 366: for (my $version=1;$version<=$reshash{'version'};$version++) { 367: my $time=$reshash{"$version:timestamp"}; 368: foreach my $key (sort(split(/\:/,$reshash{$version.':keys'}))) { 369: if (($key=~/\.(\w+)\.(\w+)\.submission$/)) { 370: my $Id1 = $1; my $Id2 = $2; 371: #check if this is a repeat submission, if so skip it 372: if ($reshash{"$version:resource.$Id1.previous"}) { next; } 373: #if no solved this wasn't a real submission, ignore it 374: if (!defined($reshash{"$version:resource.$Id1.solved"})) { 375: &Apache::lonxml::debug("skipping "); 376: next; 377: } 378: my $Resp = $reshash{"$version:$key"}; 379: my %submission=&Apache::lonnet::str2hash($Resp); 380: foreach (keys %submission) { 381: my $Ansr = $analyzeData->{"$Id1.$Id2.foil.value.$_"}; 382: if($submission{$_} eq $Ansr) { 383: &Decide("true", $foil_to_concept->{$_}, 384: $time, $ConceptData); 385: } else { 386: &Decide("false", $foil_to_concept->{$_}, 387: $time, $ConceptData); 388: } 389: } 390: } 391: } 392: } 393: } 394: } 395: 396: return; 397: } 398: 399: 400: sub DrawGraph { 401: my ($k,$Src,$Concepts,$ConceptData)=@_; 402: my $Max=0; 403: my @data1; 404: my @data2; 405: 406: # Adjust Data and find the Max 407: for (my $n=0; $n<(scalar @$Concepts); $n++ ) { 408: my $tmp=$Concepts->[$n]; 409: $data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'}; 410: $data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'}; 411: my $Sum=$data1[$n]+$data2[$n]; 412: if($Max < $Sum) { 413: $Max=$Sum; 414: } 415: } 416: for (my $n=0; $n<(scalar @$Concepts); $n++ ) { 417: if ($data1[$n]+$data2[$n]<$Max) { 418: $data2[$n]+=$Max-($data1[$n]+$data2[$n]); 419: } 420: } 421: my $P_No = (scalar @data1); 422: 423: if($Max > 1) { 424: $Max += (10 - $Max % 10); 425: $Max = int($Max); 426: } else { 427: $Max = 1; 428: } 429: 430: my $Titr=($ConceptData->{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src; 431: # $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2; 432: my $GData = ''; 433: $GData = $Titr.'&Concepts&Answers&'.$Max.'&'.$P_No.'&'; 434: $GData .= (join(',',@data1)).'&'.(join(',',@data2)); 435: 436: return '<IMG src="/cgi-bin/graph.png?'.$GData.'" border=1/>'; 437: } 438: 439: sub DrawTable { 440: my ($k,$Concepts,$ConceptData)=@_; 441: my $Max=0; 442: my @data1; 443: my @data2; 444: my $Correct=0; 445: my $Wrong=0; 446: for(my $n=0; $n<(scalar @$Concepts); $n++ ) { 447: my $tmp=$Concepts->[$n]; 448: $data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'}; 449: $Correct+=$data1[$n]; 450: $data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'}; 451: $Wrong+=$data2[$n]; 452: my $Sum=$data1[$n]+$data2[$n]; 453: if($Max < $Sum) { 454: $Max=$Sum; 455: } 456: } 457: for(my $n=0; $n<(scalar @$Concepts); $n++ ) { 458: if ($data1[$n]+$data2[$n]<$Max) { 459: $data2[$n]+=$Max-($data1[$n]+$data2[$n]); 460: } 461: } 462: my $P_No = (scalar @data1); 463: my $Str = ''; 464: # $Str .= '<br><b>From: ['.localtime($ConceptData->{'Int.'.($k-1)}); 465: # $Str .= '] To: ['.localtime($ConceptData->{"Int.$k"}).']</b>'; 466: $Str .= "\n".'<table border=2>'. 467: "\n".'<tr>'. 468: "\n".'<th> # </th>'. 469: "\n".'<th> Concept </th>'. 470: "\n".'<th> Correct </th>'. 471: "\n".'<th> Wrong </th>'. 472: "\n".'</tr>'; 473: 474: for(my $n=0; $n<(scalar @$Concepts); $n++ ) { 475: $Str .= '<tr>'."\n"; 476: $Str .= '<td>'.($n+1).'</td>'."\n"; 477: my ($currentConcept) = split('::',$Concepts->[$n]); 478: $Str .= '<td bgcolor="EEFFCC">'.$currentConcept; 479: $Str .= '</td>'."\n"; 480: $Str .= '<td bgcolor="DDFFDD">'.$data1[$n].'</td>'."\n"; 481: $Str .= '<td bgcolor="FFDDDD">'.$data2[$n].'</td>'."\n"; 482: $Str .= '</tr>'."\n"; 483: } 484: $Str .= '<td></td><td><b>From:['.localtime($ConceptData->{'Int.'.$k}); 485: $Str .= '] To: ['.localtime($ConceptData->{'Int.'.($k+1)}-1); 486: $Str .= ']</b></td><td>'.$Correct.'</td><td>'.$Wrong.'</td>'; 487: $Str .= '</table>'."\n"; 488: 489: return $Str; 490: #$Apache::lonxml::debug=1; 491: #&Apache::lonhomework::showhash(%ConceptData); 492: #$Apache::lonxml::debug=0; 493: } 494: 495: #---- END Analyze Web Page ---------------------------------------------- 496: 497: sub Decide { 498: #deciding the true or false answer belongs to each interval 499: my ($type,$concept,$time,$ConceptData)=@_; 500: my $k=0; 501: while($time > $ConceptData->{'Int.'.($k+1)} && 502: $k < $ConceptData->{'Interval'}) { 503: $k++; 504: } 505: $ConceptData->{$concept.'.'.$k.'.'.$type}++; 506: 507: return; 508: } 509: 510: sub InitAnalysis { 511: my ($uri,$part,$responseId,$problem,$student,$courseID)=@_; 512: my ($name,$domain)=split(/\:/,$student); 513: 514: my %analyzeData; 515: # Render the student's view of the problem. $Answ is the problem 516: # Stringafied 517: my $Answ=&Apache::lonnet::ssi($uri,('grade_target' => 'analyze', 518: 'grade_username' => $name, 519: 'grade_domain' => $domain, 520: 'grade_courseid' => $courseID, 521: 'grade_symb' => $problem)); 522: my ($Answer)=&Apache::lonnet::str2hashref($Answ); 523: 524: my $found = 0; 525: my @parts=(); 526: if(defined($responseId)) { 527: foreach (@{$Answer->{'parts'}}) { 528: if($_ eq $part.'.'.$responseId) { 529: push(@parts, $_); 530: $found = 1; 531: last; 532: } 533: } 534: } else { 535: foreach (@{$Answer->{'parts'}}) { 536: if($_ =~ /$part/) { 537: push(@parts, $_); 538: $found = 1; 539: last; 540: } 541: } 542: } 543: 544: if($found == 0) { 545: $analyzeData{'error'} = 'No parts matching selected values'; 546: return \%analyzeData; 547: } 548: 549: my @Concepts=(); 550: my %foil_to_concept; 551: foreach my $currentPart (@parts) { 552: if(defined($Answer->{$currentPart.'.concepts'})) { 553: foreach my $concept (@{$Answer->{$currentPart.'.concepts'}}) { 554: push(@Concepts, $concept); 555: foreach my $foil (@{$Answer->{$currentPart.'.concept.'. 556: $concept}}) { 557: $analyzeData{$currentPart.'.foil.value.'.$foil} = 558: $Answer->{$currentPart.'.foil.value.'.$foil}; 559: $foil_to_concept{$foil} = $concept; 560: } 561: } 562: } else { 563: foreach (keys(%$Answer)) { 564: if(/$currentPart.foil\.value\.(.*)$/) { 565: push(@Concepts, $1); 566: $foil_to_concept{$1} = $1; 567: $analyzeData{$currentPart.'.foil.value.'.$1} = 568: $Answer->{$currentPart.'.foil.value.'.$1}; 569: } 570: } 571: } 572: } 573: 574: $analyzeData{'parts'} = \@parts; 575: $analyzeData{'concepts'} = \@Concepts; 576: $analyzeData{'foil_to_concept'} = \%foil_to_concept; 577: 578: return \%analyzeData; 579: } 580: 581: sub Interval { 582: my ($part,$symb,$interval,$Concepts,$ConceptData)=@_; 583: my $Int=$interval; 584: my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb); 585: my $opn = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb); 586: my $add=int(($due-$opn)/$Int); 587: $ConceptData->{'Int.0'}=$opn; 588: for(my $i=1; $i<$Int; $i++) { 589: $ConceptData->{'Int.'.$i}=$opn+$i*$add; 590: } 591: $ConceptData->{'Int.'.$Int}=$due; 592: for(my $i=0; $i<$Int; $i++) { 593: for(my $n=0; $n<(scalar @$Concepts); $n++ ) { 594: my $tmp=$Concepts->[$n]; 595: $ConceptData->{$tmp.'.'.$i.'.true'}=0; 596: $ConceptData->{$tmp.'.'.$i.'.false'}=0; 597: } 598: } 599: } 600: 1; 601: __END__