File:  [LON-CAPA] / loncom / interface / statistics / lonproblemanalysis.pm
Revision 1.8: download - view: text, annotated - select for diffs
Wed Aug 14 20:42:49 2002 UTC (21 years, 10 months ago) by stredwic
Branches: MAIN
CVS tags: HEAD
Fixed a problem with statistics calculations, acts funny when testing near
zero.  Fixed sequence displays for problem statistics so that the sequences
are in the proper order.  Same with problem analysis.  Also removed
discussion column from statistics.

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: lonproblemanalysis.pm,v 1.8 2002/08/14 20:42:49 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:     untie(%cache);
  119: 
  120:     if(&Apache::loncoursedata::DownloadStudentCourseDataSeparate($students, 
  121:                                                                  'true', 
  122:                                                                  $cacheDB, 
  123:                                                                  'true', 
  124:                                                                  'true', 
  125:                                                                  $courseID, 
  126:                                                                  $r, 
  127:                                                                  $c) ne 'OK') {
  128:         $r->print($Str);
  129:         return;
  130:     }
  131: 
  132: 
  133:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
  134:         $Str .= 'Unable to tie database.';
  135:         $r->print($Str);
  136:         return;
  137:     }
  138: 
  139:     my ($problemId, $part, $responseId)=split(':',$cache{'AnalyzeInfo'});
  140:     my $uri      = $cache{$problemId.':source'};
  141:     my $problem  = $cache{$problemId.':problem'}; 
  142:     my $title    = $cache{$problemId.':title'};
  143:     my $interval = $cache{'Interval'};
  144: 
  145:     my %ConceptData;
  146:     $ConceptData{"Interval"} = $interval;
  147: 
  148:     #Initialize the option response true answers
  149:     my ($analyzeData) = &InitAnalysis($uri, $part, $responseId, $problem, 
  150:                                       $students->[0], $courseID);
  151:     if(defined($analyzeData->{'error'})) {
  152:         $Str .= $analyzeData->{'error'}.'<br>Incorrect part requested.<br>';
  153:         $r->print($Str);
  154:         return;
  155:     }
  156: 
  157:     $r->print($Str);
  158:     $Str = '';
  159:     if($c->aborted()) {  untie(%cache); return; }
  160: 
  161:     #compute the intervals
  162:     &Interval($part, $problem, $interval, $analyzeData->{'concepts'}, 
  163:               \%ConceptData);
  164: 
  165:     $title =~ s/\ /"_"/eg;
  166:     $Str .= '<br><b>'.$uri.'</b>';
  167: 
  168:     $r->print($Str);
  169:     $Str = '';
  170:     if($c->aborted()) {  untie(%cache); return; }
  171:          
  172:     #Java script Progress window
  173:     for(my $index=0; $index<(scalar @$students); $index++) {
  174:         if($c->aborted()) {  untie(%cache); return; }
  175: 	&OpStatus($problemId, $students->[$index], \%ConceptData, 
  176:                   $analyzeData->{'foil_to_concept'}, $analyzeData, \%cache);
  177:     }
  178: 
  179:     $Str .= '<br>';
  180:     for (my $k=0; $k<$interval; $k++ ) {
  181:         if($c->aborted()) {  untie(%cache); return $Str; }
  182: 	$Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'}, 
  183:                            \%ConceptData);
  184:         $r->print($Str);
  185:         $Str = '';
  186:     }
  187:     for (my $k=0; $k<$interval; $k++ ) {
  188:         if($c->aborted()) {  untie(%cache); return $Str; }
  189: 	$Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData);
  190:         $r->print($Str);
  191:         $Str = '';
  192:     }
  193:     my $Answ=&Apache::lonnet::ssi($uri);
  194:     $Str .= '<br><b>Here you can see the Problem:</b><br>'.$Answ;
  195:     $Str .= '<form>';
  196:     $r->print($Str);
  197: 
  198:     untie(%cache);
  199: 
  200:     return;
  201: }
  202: 
  203: #---- Problem Analysis Web Page ----------------------------------------------
  204: 
  205: sub IntervalOptions {
  206:     my ($selectedInterval)=@_;
  207: 
  208:     my $interval = 1;
  209:     for(my $n=1; $n<=7; $n++) {
  210:         if($selectedInterval == $n) {
  211:             $interval = $n;
  212:         }
  213:     }
  214: 
  215:     my $Ptr = '<select name="Interval">'."\n";
  216:     for(my $n=1; $n<=7;$ n++) {
  217: 	$Ptr .= '<option';
  218:         if($interval == $n) {
  219:             $Ptr .= ' selected';
  220:         }
  221: 	$Ptr .= '>'.$n."</option>"."\n";
  222:     }
  223:     $Ptr .= '</select>'."\n";
  224: 
  225:     return $Ptr;
  226: }
  227: 
  228: sub OptionResponseTable {
  229:     my ($optionResponses,$cache)=@_;
  230: 
  231:     my @optionResponses=split(':::', $optionResponses);
  232:     my %partCount;
  233:     my %sequences;
  234:     my @orderedSequences=();
  235:     foreach(@optionResponses) {
  236:         my ($sequence, $problemId, $part, undef)=split(':',$_);
  237:         $partCount{$problemId.':'.$part}++;
  238:         if(!defined($sequences{$sequence})) {
  239:             push(@orderedSequences, $sequence);
  240:             $sequences{$sequence} = $_;
  241:         } else {
  242:             $sequences{$sequence} .= ':::'.$_;
  243:         }
  244:     }
  245: 
  246:     my $Str = '';
  247: 
  248:     foreach my $sequence (@orderedSequences) {
  249:         my @optionProblems = split(':::', $sequences{$sequence});
  250: 
  251:         $Str .= '<b>'.$cache->{$sequence.':title'}.'</b>'."\n";
  252:         $Str .= "<table border=2><tr><th> \# </th><th> Problem Title </th>";
  253:         $Str .= '<th> Resource </th><th> Analysis  </th></tr>'."\n";
  254: 
  255:         my $count = 1;
  256:         foreach(@optionProblems) {
  257:             my (undef, $problemId, $part, $response)=
  258:                 split(':',$sequences{$sequence});
  259:             my $uri = $cache->{$problemId.':source'};
  260:             my $title = $cache->{$problemId.':title'};
  261: 
  262:             my $Temp = '<a href="'.$uri.'" target="_blank">'.$title.'</a>';
  263:             $Str .= '<tr>';
  264:             $Str .= '<td> '.$count.' </td>';
  265:             $Str .= '<td bgcolor="#DDFFDD">'.$Temp.'</td>';
  266:             $Str .= '<td bgcolor="#EEFFCC">'.$uri.'</td>';
  267:             if($partCount{$problemId.':'.$part} < 2) {
  268:                 $Str .= '<td><input type="submit" name="Analyze:::';
  269:                 $Str .= $problemId.':'.$part.'" value="';
  270:                 $Str .= 'Part '.$part;
  271:                 $Str .= '" /></td></tr>'."\n";
  272:             } else {
  273:                 my $value = $problemId.':'.$part.':'.$response;
  274:                 $Str .= '<td><input type="submit" name="Analyze:::'.$value;
  275:                 $Str .= '" value="';
  276:                 $Str .= 'Part '.$part.' Response '.$response;
  277:                 $Str .= '" /></td></tr>'."\n";
  278:             }
  279:             $count++;
  280:         }
  281:         $Str .= '</table><br>'."\n";
  282:     }
  283: 
  284:     return $Str;
  285: }
  286: 
  287: #---- END Problem Analysis Web Page ------------------------------------------
  288: 
  289: #---- Analyze Web Page -------------------------------------------------------
  290: 
  291: #restore the student submissions and finding the result
  292: sub OpStatus {
  293:     my ($problemID, $student, $ConceptData, $foil_to_concept, 
  294:         $analyzeData, $cache)=@_;
  295: 
  296:     my $ids = $analyzeData->{'parts'};
  297:     my @True = ();
  298:     my @False = ();
  299:     my $flag=0;
  300: 
  301:     my $tries=0;
  302: 
  303:     foreach my $id (@$ids) {
  304:         my ($part, $response) = split(/\./, $id);
  305:         my $time=$cache->{$student.':'.$problemID.':'.$part.':timestamp'};
  306:         my @submissions = split(':::', $cache->{$student.':'.$problemID.':'.
  307:                                                 $part.':'.$response.
  308:                                                 ':submission'});
  309:         foreach my $Resp (@submissions) {
  310:             my %submission=&Apache::lonnet::str2hash($Resp);
  311:             foreach (keys(%submission)) {
  312:                 if($submission{$_}) {
  313:                     my $answer = $analyzeData->{$id.'.foil.value.'.$_};
  314:                     if($submission{$_} eq $answer) {
  315:                         &Decide("true", $foil_to_concept->{$_}, 
  316:                                 $time, $ConceptData);
  317:                     } else {
  318:                         &Decide("false", $foil_to_concept->{$_}, 
  319:                                 $time, $ConceptData);
  320:                     }
  321:                 }
  322:             }
  323:         }
  324:     }
  325: 
  326:     return;
  327: }
  328: 
  329: sub DrawGraph {
  330:     my ($k,$Src,$Concepts,$ConceptData)=@_;
  331:     my $Max=0;
  332:     my @data1;
  333:     my @data2;
  334: 
  335:     # Adjust Data and find the Max 
  336:     for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
  337: 	my $tmp=$Concepts->[$n];
  338: 	$data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
  339: 	$data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
  340: 	my $Sum=$data1[$n]+$data2[$n];
  341: 	if($Max < $Sum) {
  342:             $Max=$Sum;
  343:         }
  344:     }
  345:     for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
  346: 	if ($data1[$n]+$data2[$n]<$Max) {
  347: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
  348: 	}
  349:     }
  350:     my $P_No = (scalar @data1);
  351: 
  352:     if($Max > 1) { 
  353: 	$Max += (10 - $Max % 10);
  354: 	$Max = int($Max);
  355:     } else {
  356:         $Max = 1;
  357:     }
  358: 
  359:     my $Titr=($ConceptData->{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
  360: #    $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
  361:     my $GData = '';
  362:     $GData  = $Titr.'&Concepts&Answers&'.$Max.'&'.$P_No.'&';
  363:     $GData .= (join(',',@data1)).'&'.(join(',',@data2));
  364: 
  365:     return '<IMG src="/cgi-bin/graph.gif?'.$GData.'" border=1/>';
  366: }
  367: 
  368: sub DrawTable {
  369:     my ($k,$Concepts,$ConceptData)=@_;
  370:     my $Max=0;
  371:     my @data1;
  372:     my @data2;
  373:     my $Correct=0;
  374:     my $Wrong=0;
  375:     for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  376: 	my $tmp=$Concepts->[$n];
  377: 	$data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
  378: 	$Correct+=$data1[$n];
  379: 	$data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
  380: 	$Wrong+=$data2[$n];
  381: 	my $Sum=$data1[$n]+$data2[$n];
  382: 	if($Max < $Sum) {
  383:             $Max=$Sum;
  384:         }
  385:     }
  386:     for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  387: 	if ($data1[$n]+$data2[$n]<$Max) {
  388: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
  389: 	}
  390:     }
  391:     my $P_No = (scalar @data1);
  392:     my $Str = '';
  393: #    $Str .= '<br><b>From: ['.localtime($ConceptData->{'Int.'.($k-1)});
  394: #    $Str .= '] To: ['.localtime($ConceptData->{"Int.$k"}).']</b>'; 
  395:     $Str .= "\n".'<table border=2>'.
  396:             "\n".'<tr>'.
  397:             "\n".'<th> # </th>'.
  398:             "\n".'<th> Concept </th>'.
  399:             "\n".'<th> Correct </th>'.
  400:             "\n".'<th> Wrong </th>'.
  401:             "\n".'</tr>';
  402: 
  403:     for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  404: 	$Str .= '<tr>'."\n";
  405:         $Str .= '<td>'.($n+1).'</td>'."\n";
  406:         my ($currentConcept) = split('::',$Concepts->[$n]);
  407:         $Str .= '<td bgcolor="EEFFCC">'.$currentConcept;
  408:         $Str .= '</td>'."\n";
  409:         $Str .= '<td bgcolor="DDFFDD">'.$data1[$n].'</td>'."\n";
  410:         $Str .= '<td bgcolor="FFDDDD">'.$data2[$n].'</td>'."\n";
  411:         $Str .= '</tr>'."\n";
  412:     }
  413:     $Str .= '<td></td><td><b>From:['.localtime($ConceptData->{'Int.'.$k});
  414:     $Str .= '] To: ['.localtime($ConceptData->{'Int.'.($k+1)}-1);
  415:     $Str .= ']</b></td><td>'.$Correct.'</td><td>'.$Wrong.'</td>';
  416:     $Str .= '</table>'."\n";
  417: 
  418:     return $Str;
  419: #$Apache::lonxml::debug=1;
  420: #&Apache::lonhomework::showhash(%ConceptData);
  421: #$Apache::lonxml::debug=0;
  422: }
  423: 
  424: #---- END Analyze Web Page ----------------------------------------------
  425: 
  426: sub Decide {
  427:     #deciding the true or false answer belongs to each interval
  428:     my ($type,$concept,$time,$ConceptData)=@_; 
  429:     my $k=0;
  430:     while($time > $ConceptData->{'Int.'.($k+1)} && 
  431:            $k < $ConceptData->{'Interval'}) {
  432:         $k++;
  433:     }
  434:     $ConceptData->{$concept.'.'.$k.'.'.$type}++;
  435: 
  436:     return;
  437: }
  438: 
  439: sub InitAnalysis {
  440:     my ($uri,$part,$responseId,$problem,$student,$courseID)=@_;
  441:     my ($name,$domain)=split(/\:/,$student);
  442: 
  443:     my %analyzeData;
  444:     # Render the student's view of the problem.  $Answ is the problem 
  445:     # Stringafied
  446:     my $Answ=&Apache::lonnet::ssi($uri,('grade_target'   => 'analyze',
  447:                                         'grade_username' => $name,
  448:                                         'grade_domain'   => $domain,
  449:                                         'grade_courseid' => $courseID,
  450:                                         'grade_symb'     => $problem));
  451:     my ($Answer)=&Apache::lonnet::str2hashref($Answ);
  452: 
  453:     my $found = 0;
  454:     my @parts=();
  455:     if(defined($responseId)) {
  456:         foreach (@{$Answer->{'parts'}}) {
  457:             if($_ eq $part.'.'.$responseId) {
  458:                 push(@parts, $_);
  459:                 $found = 1;
  460:                 last;
  461:             }
  462:         }
  463:     } else {
  464:         foreach (@{$Answer->{'parts'}}) {
  465:             if($_ =~ /$part/) {
  466:                 push(@parts, $_);
  467:                 $found = 1;
  468:                 last;
  469:             }
  470:         }
  471:     }
  472: 
  473:     if($found == 0) {
  474:         $analyzeData{'error'} = 'No parts matching selected values';
  475:         return \%analyzeData;
  476:     }
  477: 
  478:     my @Concepts=();
  479:     my %foil_to_concept;
  480:     foreach my $currentPart (@parts) {
  481:         if(defined($Answer->{$currentPart.'.concepts'})) {
  482:             foreach my $concept (@{$Answer->{$currentPart.'.concepts'}}) {
  483:                 push(@Concepts, $concept);
  484:                 foreach my $foil (@{$Answer->{$currentPart.'.concept.'.
  485:                                             $concept}}) {
  486:                     $analyzeData{$currentPart.'.foil.value.'.$foil} =
  487:                         $Answer->{$currentPart.'.foil.value.'.$foil};
  488:                     $foil_to_concept{$foil} = $concept;
  489:                 }
  490:             }
  491:         } else {
  492:             foreach (keys(%$Answer)) {
  493:                 if(/$currentPart.foil\.value\.(.*)$/) {
  494:                     push(@Concepts, $1);
  495:                     $foil_to_concept{$1} = $1;
  496:                     $analyzeData{$currentPart.'.foil.value.'.$1} =
  497:                         $Answer->{$currentPart.'.foil.value.'.$1};
  498:                 }
  499:             }
  500:         }
  501:     }
  502: 
  503:     $analyzeData{'parts'} = \@parts;
  504:     $analyzeData{'concepts'} = \@Concepts;
  505:     $analyzeData{'foil_to_concept'} = \%foil_to_concept;
  506: 
  507:     return \%analyzeData;
  508: }
  509: 
  510: sub Interval {
  511:     my ($part,$symb,$interval,$Concepts,$ConceptData)=@_;
  512:     my $Int=$interval;
  513:     my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb);
  514:     my $opn = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb);
  515:     my $add=int(($due-$opn)/$Int);
  516:     $ConceptData->{'Int.0'}=$opn;
  517:     for(my $i=1; $i<$Int; $i++) {
  518: 	$ConceptData->{'Int.'.$i}=$opn+$i*$add;
  519:     }
  520:     $ConceptData->{'Int.'.$Int}=$due;     
  521:     for(my $i=0; $i<$Int; $i++) {
  522: 	for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  523: 	    my $tmp=$Concepts->[$n];
  524: 	    $ConceptData->{$tmp.'.'.$i.'.true'}=0;
  525: 	    $ConceptData->{$tmp.'.'.$i.'.false'}=0;
  526: 	}
  527:     }
  528: }
  529: 1;
  530: __END__

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