File:  [LON-CAPA] / loncom / interface / statistics / lonproblemanalysis.pm
Revision 1.9: download - view: text, annotated - select for diffs
Wed Aug 14 21:51:51 2002 UTC (21 years, 10 months ago) by stredwic
Branches: MAIN
CVS tags: version_0_5, HEAD
Fixed the number not updating in the status window for update all students
button.  Also fixed some tieing to hash problems for lonproblemstatistics
and lonproblemanalysis.

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: lonproblemanalysis.pm,v 1.9 2002/08/14 21:51:51 stredwic 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  Behrouz Minaei
   35: #
   36: ###
   37: 
   38: package Apache::lonproblemanalysis; 
   39: 
   40: use strict;
   41: use Apache::lonnet();
   42: use Apache::lonhtmlcommon();
   43: use GDBM_File;
   44: 
   45: my $jr;
   46: 
   47: sub BuildProblemAnalysisPage {
   48:     my ($cacheDB, $r)=@_;
   49: 
   50:     my %cache;
   51:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
   52:         $r->print('Unable to tie database.');
   53:         return;
   54:     }
   55: 
   56:     my $Ptr = '';
   57:     $Ptr .= '<table border="0"><tbody>';
   58:     $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
   59:     $Ptr .= '</td>'."\n";
   60:     $Ptr .= '<td align="left">'."\n";
   61:     my @sectionsSelected = split(':',$cache{'sectionsSelected'});
   62:     my @sections = split(':',$cache{'sectionList'});
   63:     $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
   64:                                                           \@sectionsSelected,
   65:                                                           'Statistics');
   66:     $Ptr .= '</td></tr>'."\n";
   67:     $Ptr .= '<tr><td align="right"><b>Intervals</b></td>'."\n";
   68:     $Ptr .= '<td align="left">';
   69:     $Ptr .= &IntervalOptions($cache{'Interval'});
   70:     $Ptr .= '</td></tr></table><br>';
   71:     $r->print($Ptr);
   72:     $r->rflush();
   73:     $r->print(&OptionResponseTable($cache{'OptionResponses'}, \%cache));
   74: 
   75:     untie(%cache);
   76: 
   77:     return;
   78: }
   79: 
   80: sub BuildAnalyzePage {
   81:     my ($cacheDB, $students, $courseID,$r)=@_;
   82: 
   83:     $jr = $r;
   84:     my $c = $r->connection;
   85: 
   86:     my $Str = '</form>';
   87:     my %cache;
   88: 
   89:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
   90:         $Str .= 'Unable to tie database.';
   91:         $r->print($Str);
   92:         return;
   93:     }
   94: 
   95:     # Remove students who don't have the proper section.
   96:     my @sectionsSelected = split(':',$cache{'sectionsSelected'});
   97:     for(my $studentIndex=((scalar @$students)-1); $studentIndex>=0;
   98:         $studentIndex--) {
   99:         my $value = $cache{$students->[$studentIndex].':section'};
  100:         my $found = 0;
  101:         foreach (@sectionsSelected) {
  102:             if($_ eq 'none') {
  103:                 if($value eq '' || !defined($value) || $value eq ' ') {
  104:                     $found = 1;
  105:                     last;
  106:                 }
  107:             } else {
  108:                 if($value eq $_) {
  109:                     $found = 1;
  110:                     last;
  111:                 }
  112:             }
  113:         }
  114:         if($found == 0) {
  115:             splice(@$students, $studentIndex, 1);
  116:         }
  117:     }
  118:     unless(untie(%cache)) {
  119:         $r->print('Can not untie hash.');
  120:         $r->rflush();
  121:     }
  122: 
  123:     my $error = 
  124:         &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
  125:                                                                   'true',
  126:                                                                   $cacheDB,
  127:                                                                   'true', 
  128:                                                                   'true',
  129:                                                                   $courseID,
  130:                                                                   $r, $c);
  131:     if($error ne 'OK') {
  132:         $r->print($error.'<br>Error downloading course data<br>');
  133:         return;
  134:     }
  135: 
  136: 
  137:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
  138:         $Str .= 'Unable to tie database.';
  139:         $r->print($Str);
  140:         return;
  141:     }
  142: 
  143:     my ($problemId, $part, $responseId)=split(':',$cache{'AnalyzeInfo'});
  144:     my $uri      = $cache{$problemId.':source'};
  145:     my $problem  = $cache{$problemId.':problem'}; 
  146:     my $title    = $cache{$problemId.':title'};
  147:     my $interval = $cache{'Interval'};
  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:     #Java script Progress window
  177:     for(my $index=0; $index<(scalar @$students); $index++) {
  178:         if($c->aborted()) {  untie(%cache); return; }
  179: 	&OpStatus($problemId, $students->[$index], \%ConceptData, 
  180:                   $analyzeData->{'foil_to_concept'}, $analyzeData, \%cache);
  181:     }
  182: 
  183:     $Str .= '<br>';
  184:     for (my $k=0; $k<$interval; $k++ ) {
  185:         if($c->aborted()) {  untie(%cache); return $Str; }
  186: 	$Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'}, 
  187:                            \%ConceptData);
  188:         $r->print($Str);
  189:         $Str = '';
  190:     }
  191:     for (my $k=0; $k<$interval; $k++ ) {
  192:         if($c->aborted()) {  untie(%cache); return $Str; }
  193: 	$Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData);
  194:         $r->print($Str);
  195:         $Str = '';
  196:     }
  197:     my $Answ=&Apache::lonnet::ssi($uri);
  198:     $Str .= '<br><b>Here you can see the Problem:</b><br>'.$Answ;
  199:     $Str .= '<form>';
  200:     $r->print($Str);
  201: 
  202:     untie(%cache);
  203: 
  204:     return;
  205: }
  206: 
  207: #---- Problem Analysis Web Page ----------------------------------------------
  208: 
  209: sub IntervalOptions {
  210:     my ($selectedInterval)=@_;
  211: 
  212:     my $interval = 1;
  213:     for(my $n=1; $n<=7; $n++) {
  214:         if($selectedInterval == $n) {
  215:             $interval = $n;
  216:         }
  217:     }
  218: 
  219:     my $Ptr = '<select name="Interval">'."\n";
  220:     for(my $n=1; $n<=7;$ n++) {
  221: 	$Ptr .= '<option';
  222:         if($interval == $n) {
  223:             $Ptr .= ' selected';
  224:         }
  225: 	$Ptr .= '>'.$n."</option>"."\n";
  226:     }
  227:     $Ptr .= '</select>'."\n";
  228: 
  229:     return $Ptr;
  230: }
  231: 
  232: sub OptionResponseTable {
  233:     my ($optionResponses,$cache)=@_;
  234: 
  235:     my @optionResponses=split(':::', $optionResponses);
  236:     my %partCount;
  237:     my %sequences;
  238:     my @orderedSequences=();
  239:     foreach(@optionResponses) {
  240:         my ($sequence, $problemId, $part, undef)=split(':',$_);
  241:         $partCount{$problemId.':'.$part}++;
  242:         if(!defined($sequences{$sequence})) {
  243:             push(@orderedSequences, $sequence);
  244:             $sequences{$sequence} = $_;
  245:         } else {
  246:             $sequences{$sequence} .= ':::'.$_;
  247:         }
  248:     }
  249: 
  250:     my $Str = '';
  251: 
  252:     foreach my $sequence (@orderedSequences) {
  253:         my @optionProblems = split(':::', $sequences{$sequence});
  254: 
  255:         $Str .= '<b>'.$cache->{$sequence.':title'}.'</b>'."\n";
  256:         $Str .= "<table border=2><tr><th> \# </th><th> Problem Title </th>";
  257:         $Str .= '<th> Resource </th><th> Analysis  </th></tr>'."\n";
  258: 
  259:         my $count = 1;
  260:         foreach(@optionProblems) {
  261:             my (undef, $problemId, $part, $response)=
  262:                 split(':',$sequences{$sequence});
  263:             my $uri = $cache->{$problemId.':source'};
  264:             my $title = $cache->{$problemId.':title'};
  265: 
  266:             my $Temp = '<a href="'.$uri.'" target="_blank">'.$title.'</a>';
  267:             $Str .= '<tr>';
  268:             $Str .= '<td> '.$count.' </td>';
  269:             $Str .= '<td bgcolor="#DDFFDD">'.$Temp.'</td>';
  270:             $Str .= '<td bgcolor="#EEFFCC">'.$uri.'</td>';
  271:             if($partCount{$problemId.':'.$part} < 2) {
  272:                 $Str .= '<td><input type="submit" name="Analyze:::';
  273:                 $Str .= $problemId.':'.$part.'" value="';
  274:                 $Str .= 'Part '.$part;
  275:                 $Str .= '" /></td></tr>'."\n";
  276:             } else {
  277:                 my $value = $problemId.':'.$part.':'.$response;
  278:                 $Str .= '<td><input type="submit" name="Analyze:::'.$value;
  279:                 $Str .= '" value="';
  280:                 $Str .= 'Part '.$part.' Response '.$response;
  281:                 $Str .= '" /></td></tr>'."\n";
  282:             }
  283:             $count++;
  284:         }
  285:         $Str .= '</table><br>'."\n";
  286:     }
  287: 
  288:     return $Str;
  289: }
  290: 
  291: #---- END Problem Analysis Web Page ------------------------------------------
  292: 
  293: #---- Analyze Web Page -------------------------------------------------------
  294: 
  295: #restore the student submissions and finding the result
  296: sub OpStatus {
  297:     my ($problemID, $student, $ConceptData, $foil_to_concept, 
  298:         $analyzeData, $cache)=@_;
  299: 
  300:     my $ids = $analyzeData->{'parts'};
  301:     my @True = ();
  302:     my @False = ();
  303:     my $flag=0;
  304: 
  305:     my $tries=0;
  306: 
  307:     foreach my $id (@$ids) {
  308:         my ($part, $response) = split(/\./, $id);
  309:         my $time=$cache->{$student.':'.$problemID.':'.$part.':timestamp'};
  310:         my @submissions = split(':::', $cache->{$student.':'.$problemID.':'.
  311:                                                 $part.':'.$response.
  312:                                                 ':submission'});
  313:         foreach my $Resp (@submissions) {
  314:             my %submission=&Apache::lonnet::str2hash($Resp);
  315:             foreach (keys(%submission)) {
  316:                 if($submission{$_}) {
  317:                     my $answer = $analyzeData->{$id.'.foil.value.'.$_};
  318:                     if($submission{$_} eq $answer) {
  319:                         &Decide("true", $foil_to_concept->{$_}, 
  320:                                 $time, $ConceptData);
  321:                     } else {
  322:                         &Decide("false", $foil_to_concept->{$_}, 
  323:                                 $time, $ConceptData);
  324:                     }
  325:                 }
  326:             }
  327:         }
  328:     }
  329: 
  330:     return;
  331: }
  332: 
  333: sub DrawGraph {
  334:     my ($k,$Src,$Concepts,$ConceptData)=@_;
  335:     my $Max=0;
  336:     my @data1;
  337:     my @data2;
  338: 
  339:     # Adjust Data and find the Max 
  340:     for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
  341: 	my $tmp=$Concepts->[$n];
  342: 	$data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
  343: 	$data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
  344: 	my $Sum=$data1[$n]+$data2[$n];
  345: 	if($Max < $Sum) {
  346:             $Max=$Sum;
  347:         }
  348:     }
  349:     for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
  350: 	if ($data1[$n]+$data2[$n]<$Max) {
  351: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
  352: 	}
  353:     }
  354:     my $P_No = (scalar @data1);
  355: 
  356:     if($Max > 1) { 
  357: 	$Max += (10 - $Max % 10);
  358: 	$Max = int($Max);
  359:     } else {
  360:         $Max = 1;
  361:     }
  362: 
  363:     my $Titr=($ConceptData->{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
  364: #    $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
  365:     my $GData = '';
  366:     $GData  = $Titr.'&Concepts&Answers&'.$Max.'&'.$P_No.'&';
  367:     $GData .= (join(',',@data1)).'&'.(join(',',@data2));
  368: 
  369:     return '<IMG src="/cgi-bin/graph.gif?'.$GData.'" border=1/>';
  370: }
  371: 
  372: sub DrawTable {
  373:     my ($k,$Concepts,$ConceptData)=@_;
  374:     my $Max=0;
  375:     my @data1;
  376:     my @data2;
  377:     my $Correct=0;
  378:     my $Wrong=0;
  379:     for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  380: 	my $tmp=$Concepts->[$n];
  381: 	$data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
  382: 	$Correct+=$data1[$n];
  383: 	$data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
  384: 	$Wrong+=$data2[$n];
  385: 	my $Sum=$data1[$n]+$data2[$n];
  386: 	if($Max < $Sum) {
  387:             $Max=$Sum;
  388:         }
  389:     }
  390:     for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  391: 	if ($data1[$n]+$data2[$n]<$Max) {
  392: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
  393: 	}
  394:     }
  395:     my $P_No = (scalar @data1);
  396:     my $Str = '';
  397: #    $Str .= '<br><b>From: ['.localtime($ConceptData->{'Int.'.($k-1)});
  398: #    $Str .= '] To: ['.localtime($ConceptData->{"Int.$k"}).']</b>'; 
  399:     $Str .= "\n".'<table border=2>'.
  400:             "\n".'<tr>'.
  401:             "\n".'<th> # </th>'.
  402:             "\n".'<th> Concept </th>'.
  403:             "\n".'<th> Correct </th>'.
  404:             "\n".'<th> Wrong </th>'.
  405:             "\n".'</tr>';
  406: 
  407:     for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  408: 	$Str .= '<tr>'."\n";
  409:         $Str .= '<td>'.($n+1).'</td>'."\n";
  410:         my ($currentConcept) = split('::',$Concepts->[$n]);
  411:         $Str .= '<td bgcolor="EEFFCC">'.$currentConcept;
  412:         $Str .= '</td>'."\n";
  413:         $Str .= '<td bgcolor="DDFFDD">'.$data1[$n].'</td>'."\n";
  414:         $Str .= '<td bgcolor="FFDDDD">'.$data2[$n].'</td>'."\n";
  415:         $Str .= '</tr>'."\n";
  416:     }
  417:     $Str .= '<td></td><td><b>From:['.localtime($ConceptData->{'Int.'.$k});
  418:     $Str .= '] To: ['.localtime($ConceptData->{'Int.'.($k+1)}-1);
  419:     $Str .= ']</b></td><td>'.$Correct.'</td><td>'.$Wrong.'</td>';
  420:     $Str .= '</table>'."\n";
  421: 
  422:     return $Str;
  423: #$Apache::lonxml::debug=1;
  424: #&Apache::lonhomework::showhash(%ConceptData);
  425: #$Apache::lonxml::debug=0;
  426: }
  427: 
  428: #---- END Analyze Web Page ----------------------------------------------
  429: 
  430: sub Decide {
  431:     #deciding the true or false answer belongs to each interval
  432:     my ($type,$concept,$time,$ConceptData)=@_; 
  433:     my $k=0;
  434:     while($time > $ConceptData->{'Int.'.($k+1)} && 
  435:            $k < $ConceptData->{'Interval'}) {
  436:         $k++;
  437:     }
  438:     $ConceptData->{$concept.'.'.$k.'.'.$type}++;
  439: 
  440:     return;
  441: }
  442: 
  443: sub InitAnalysis {
  444:     my ($uri,$part,$responseId,$problem,$student,$courseID)=@_;
  445:     my ($name,$domain)=split(/\:/,$student);
  446: 
  447:     my %analyzeData;
  448:     # Render the student's view of the problem.  $Answ is the problem 
  449:     # Stringafied
  450:     my $Answ=&Apache::lonnet::ssi($uri,('grade_target'   => 'analyze',
  451:                                         'grade_username' => $name,
  452:                                         'grade_domain'   => $domain,
  453:                                         'grade_courseid' => $courseID,
  454:                                         'grade_symb'     => $problem));
  455:     my ($Answer)=&Apache::lonnet::str2hashref($Answ);
  456: 
  457:     my $found = 0;
  458:     my @parts=();
  459:     if(defined($responseId)) {
  460:         foreach (@{$Answer->{'parts'}}) {
  461:             if($_ eq $part.'.'.$responseId) {
  462:                 push(@parts, $_);
  463:                 $found = 1;
  464:                 last;
  465:             }
  466:         }
  467:     } else {
  468:         foreach (@{$Answer->{'parts'}}) {
  469:             if($_ =~ /$part/) {
  470:                 push(@parts, $_);
  471:                 $found = 1;
  472:                 last;
  473:             }
  474:         }
  475:     }
  476: 
  477:     if($found == 0) {
  478:         $analyzeData{'error'} = 'No parts matching selected values';
  479:         return \%analyzeData;
  480:     }
  481: 
  482:     my @Concepts=();
  483:     my %foil_to_concept;
  484:     foreach my $currentPart (@parts) {
  485:         if(defined($Answer->{$currentPart.'.concepts'})) {
  486:             foreach my $concept (@{$Answer->{$currentPart.'.concepts'}}) {
  487:                 push(@Concepts, $concept);
  488:                 foreach my $foil (@{$Answer->{$currentPart.'.concept.'.
  489:                                             $concept}}) {
  490:                     $analyzeData{$currentPart.'.foil.value.'.$foil} =
  491:                         $Answer->{$currentPart.'.foil.value.'.$foil};
  492:                     $foil_to_concept{$foil} = $concept;
  493:                 }
  494:             }
  495:         } else {
  496:             foreach (keys(%$Answer)) {
  497:                 if(/$currentPart.foil\.value\.(.*)$/) {
  498:                     push(@Concepts, $1);
  499:                     $foil_to_concept{$1} = $1;
  500:                     $analyzeData{$currentPart.'.foil.value.'.$1} =
  501:                         $Answer->{$currentPart.'.foil.value.'.$1};
  502:                 }
  503:             }
  504:         }
  505:     }
  506: 
  507:     $analyzeData{'parts'} = \@parts;
  508:     $analyzeData{'concepts'} = \@Concepts;
  509:     $analyzeData{'foil_to_concept'} = \%foil_to_concept;
  510: 
  511:     return \%analyzeData;
  512: }
  513: 
  514: sub Interval {
  515:     my ($part,$symb,$interval,$Concepts,$ConceptData)=@_;
  516:     my $Int=$interval;
  517:     my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb);
  518:     my $opn = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb);
  519:     my $add=int(($due-$opn)/$Int);
  520:     $ConceptData->{'Int.0'}=$opn;
  521:     for(my $i=1; $i<$Int; $i++) {
  522: 	$ConceptData->{'Int.'.$i}=$opn+$i*$add;
  523:     }
  524:     $ConceptData->{'Int.'.$Int}=$due;     
  525:     for(my $i=0; $i<$Int; $i++) {
  526: 	for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  527: 	    my $tmp=$Concepts->[$n];
  528: 	    $ConceptData->{$tmp.'.'.$i.'.true'}=0;
  529: 	    $ConceptData->{$tmp.'.'.$i.'.false'}=0;
  530: 	}
  531:     }
  532: }
  533: 1;
  534: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>