File:  [LON-CAPA] / loncom / interface / statistics / lonproblemanalysis.pm
Revision 1.6: download - view: text, annotated - select for diffs
Tue Aug 13 14:44:33 2002 UTC (21 years, 11 months ago) by stredwic
Branches: MAIN
CVS tags: HEAD
No longer need to unescape values from ssi individually.

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: lonproblemanalysis.pm,v 1.6 2002/08/13 14:44:33 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 GDBM_File;
   43: 
   44: my $jr;
   45: 
   46: sub BuildProblemAnalysisPage {
   47:     my ($cacheDB, $r)=@_;
   48: 
   49:     my %cache;
   50:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
   51:         $r->print('<html><body>Unable to tie database.</body></html>');
   52:         return;
   53:     }
   54: 
   55:     $r->print(&IntervalOptions($cache{'Interval'}));
   56:     $r->rflush();
   57:     $r->print(&OptionResponseTable($cache{'OptionResponses'}, \%cache));
   58: 
   59:     untie(%cache);
   60: 
   61:     return;
   62: }
   63: 
   64: sub BuildAnalyzePage {
   65:     my ($cacheDB, $students, $courseID,$r)=@_;
   66: 
   67:     $jr = $r;
   68:     my $c = $r->connection;
   69: 
   70:     my $Str = '</form>';
   71:     my %cache;
   72:     if(&Apache::loncoursedata::DownloadStudentCourseDataSeparate($students, 'true', 
   73:                                                                  $cacheDB, 'true', 
   74:                                                                  'true', $courseID, 
   75:                                                                  $r, $c) ne 'OK') {
   76:         $r->print($Str);
   77:         return;
   78:     }
   79: 
   80: 
   81:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
   82:         $Str .= '<html><body>Unable to tie database.</body></html>';
   83:         $r->print($Str);
   84:         return;
   85:     }
   86: 
   87:     my ($problemId, $part, $responseId)=split(':',$cache{'AnalyzeInfo'});
   88:     my $uri      = $cache{$problemId.':source'};
   89:     my $problem  = $cache{$problemId.':problem'}; 
   90:     my $title    = $cache{$problemId.':title'};
   91:     my $interval = $cache{'Interval'};
   92: 
   93:     my %ConceptData;
   94:     $ConceptData{"Interval"} = $interval;
   95: 
   96:     #Initialize the option response true answers
   97:     my ($analyzeData) = &InitAnalysis($uri, $part, $responseId, $problem, 
   98:                                       $students->[0], $courseID);
   99:     if(defined($analyzeData->{'error'})) {
  100:         $Str .= $analyzeData->{'error'}.'<br>Incorrect part requested.<br>';
  101:         $r->print($Str);
  102:         return;
  103:     }
  104: 
  105:     $r->print($Str);
  106:     $Str = '';
  107:     if($c->aborted()) {  untie(%cache); return; }
  108: 
  109:     #compute the intervals
  110:     &Interval($part, $problem, $interval, $analyzeData->{'concepts'}, 
  111:               \%ConceptData);
  112: 
  113:     $title =~ s/\ /"_"/eg;
  114:     $Str .= '<br><b>'.$uri.'</b>';
  115: 
  116:     $r->print($Str);
  117:     $Str = '';
  118:     if($c->aborted()) {  untie(%cache); return; }
  119:          
  120:     #Java script Progress window
  121:     for(my $index=0; $index<(scalar @$students); $index++) {
  122:         if($c->aborted()) {  untie(%cache); return; }
  123: 	&OpStatus($problemId, $students->[$index], \%ConceptData, 
  124:                   $analyzeData->{'foil_to_concept'}, $analyzeData, \%cache);
  125:     }
  126: 
  127:     $Str .= '<br>';
  128:     for (my $k=0; $k<$interval; $k++ ) {
  129:         if($c->aborted()) {  untie(%cache); return $Str; }
  130: 	$Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'}, 
  131:                            \%ConceptData);
  132:         $r->print($Str);
  133:         $Str = '';
  134:     }
  135:     for (my $k=0; $k<$interval; $k++ ) {
  136:         if($c->aborted()) {  untie(%cache); return $Str; }
  137: 	$Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData);
  138:         $r->print($Str);
  139:         $Str = '';
  140:     }
  141:     my $Answ=&Apache::lonnet::ssi($uri);
  142:     $Str .= '<br><b>Here you can see the Problem:</b><br>'.$Answ;
  143:     $Str .= '<form>';
  144:     $r->print($Str);
  145: 
  146:     untie(%cache);
  147: 
  148:     return;
  149: }
  150: 
  151: #---- Problem Analysis Web Page ----------------------------------------------
  152: 
  153: sub IntervalOptions {
  154:     my ($selectedInterval)=@_;
  155: 
  156:     my $interval = 1;
  157:     for(my $n=1; $n<=7; $n++) {
  158:         if($selectedInterval == $n) {
  159:             $interval = $n;
  160:         }
  161:     }
  162: 
  163:     my $Ptr = '<br><b>Select number of intervals</b>'."\n".
  164:        	      '<select name="Interval">'."\n";
  165:     for(my $n=1; $n<=7;$ n++) {
  166: 	$Ptr .= '<option';
  167:         if($interval == $n) {
  168:             $Ptr .= ' selected';
  169:         }
  170: 	$Ptr .= '>'.$n."</option>"."\n";
  171:     }
  172:     $Ptr .= '</select>'."\n";
  173: 
  174:     return $Ptr;
  175: }
  176: 
  177: sub OptionResponseTable {
  178:     my ($optionResponses,$cache)=@_;
  179:     my $Str = '';
  180:     $Str .= '<br><b> Option Response Problems in this course:</b>'."\n";
  181:     $Str .= '<br><br>'."\n";
  182:     $Str .= "<table border=2><tr><th> \# </th><th> Problem Title </th>";
  183:     $Str .= '<th> Resource </th><th> Analysis  </th></tr>'."\n";
  184: 
  185:     my $number=1;
  186:     my @optionResponses=split(':::', $optionResponses);
  187:     my %partCount;
  188:     foreach (@optionResponses) {
  189:         my ($problemId, $part, undef)=split(':',$_);
  190:         $partCount{$problemId.':'.$part}++;
  191:     }
  192: 
  193:     foreach (@optionResponses) {
  194:         my ($problemId, $part, $response)=split(':',$_);
  195:         my $uri = $cache->{$problemId.':source'};
  196:         my $title = $cache->{$problemId.':title'};
  197: 
  198:         my $Temp = '<a href="'.$uri.'" target="_blank">'.$title.'</a>';
  199:         $Str .= '<tr>';
  200:         $Str .= '<td> '.$number.' </td>';
  201:         $Str .= '<td bgcolor="#DDFFDD">'.$Temp.'</td>';
  202:         $Str .= '<td bgcolor="#EEFFCC">'.$uri.'</td>';
  203:         if($partCount{$problemId.':'.$part} < 2) {
  204:             $Str .= '<td><input type="submit" name="Analyze:::';
  205:             $Str .= $problemId.':'.$part.'" value="';
  206:             $Str .= 'Part '.$part;
  207:             $Str .= '" /></td></tr>'."\n";
  208:         } else {
  209:             $Str .= '<td><input type="submit" name="Analyze:::'.$_.'" value="';
  210:             $Str .= 'Part '.$part.' Response '.$response;
  211:             $Str .= '" /></td></tr>'."\n";
  212:         }
  213:         $number++;
  214:     }
  215:     $Str .= '</table>'."\n";
  216: 
  217:     return $Str;
  218: }
  219: 
  220: #---- END Problem Analysis Web Page ------------------------------------------
  221: 
  222: #---- Analyze Web Page -------------------------------------------------------
  223: 
  224: #restore the student submissions and finding the result
  225: sub OpStatus {
  226:     my ($problemID, $student, $ConceptData, $foil_to_concept, 
  227:         $analyzeData, $cache)=@_;
  228: 
  229:     my $ids = $analyzeData->{'parts'};
  230:     my @True = ();
  231:     my @False = ();
  232:     my $flag=0;
  233: 
  234:     my $tries=0;
  235: 
  236:     foreach my $id (@$ids) {
  237:         my ($part, $response) = split(/\./, $id);
  238:         my $time=$cache->{$student.':'.$problemID.':'.$part.':timestamp'};
  239:         my @submissions = split(':::', $cache->{$student.':'.$problemID.':'.
  240:                                                 $part.':'.$response.
  241:                                                 ':submission'});
  242:         foreach my $Resp (@submissions) {
  243:             my %submission=&Apache::lonnet::str2hash($Resp);
  244:             foreach (keys(%submission)) {
  245:                 if($submission{$_}) {
  246:                     my $answer = $analyzeData->{$id.'.foil.value.'.$_};
  247:                     if($submission{$_} eq $answer) {
  248:                         &Decide("true", $foil_to_concept->{$_}, 
  249:                                 $time, $ConceptData);
  250:                     } else {
  251:                         &Decide("false", $foil_to_concept->{$_}, 
  252:                                 $time, $ConceptData);
  253:                     }
  254:                 }
  255:             }
  256:         }
  257:     }
  258: 
  259:     return;
  260: }
  261: 
  262: sub DrawGraph {
  263:     my ($k,$Src,$Concepts,$ConceptData)=@_;
  264:     my $Max=0;
  265:     my @data1;
  266:     my @data2;
  267: 
  268:     # Adjust Data and find the Max 
  269:     for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
  270: 	my $tmp=$Concepts->[$n];
  271: 	$data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
  272: 	$data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
  273: 	my $Sum=$data1[$n]+$data2[$n];
  274: 	if($Max < $Sum) {
  275:             $Max=$Sum;
  276:         }
  277:     }
  278:     for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
  279: 	if ($data1[$n]+$data2[$n]<$Max) {
  280: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
  281: 	}
  282:     }
  283:     my $P_No = (scalar @data1);
  284: 
  285:     if($Max > 1) { 
  286: 	$Max += (10 - $Max % 10);
  287: 	$Max = int($Max);
  288:     } else {
  289:         $Max = 1;
  290:     }
  291: 
  292:     my $Titr=($ConceptData->{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
  293: #    $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
  294:     my $GData = '';
  295:     $GData  = $Titr.'&Concepts&Answers&'.$Max.'&'.$P_No.'&';
  296:     $GData .= (join(',',@data1)).'&'.(join(',',@data2));
  297: 
  298:     return '<IMG src="/cgi-bin/graph.gif?'.$GData.'" border=1/>';
  299: }
  300: 
  301: sub DrawTable {
  302:     my ($k,$Concepts,$ConceptData)=@_;
  303:     my $Max=0;
  304:     my @data1;
  305:     my @data2;
  306:     my $Correct=0;
  307:     my $Wrong=0;
  308:     for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  309: 	my $tmp=$Concepts->[$n];
  310: 	$data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
  311: 	$Correct+=$data1[$n];
  312: 	$data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
  313: 	$Wrong+=$data2[$n];
  314: 	my $Sum=$data1[$n]+$data2[$n];
  315: 	if($Max < $Sum) {
  316:             $Max=$Sum;
  317:         }
  318:     }
  319:     for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  320: 	if ($data1[$n]+$data2[$n]<$Max) {
  321: 	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
  322: 	}
  323:     }
  324:     my $P_No = (scalar @data1);
  325:     my $Str = '';
  326: #    $Str .= '<br><b>From: ['.localtime($ConceptData->{'Int.'.($k-1)});
  327: #    $Str .= '] To: ['.localtime($ConceptData->{"Int.$k"}).']</b>'; 
  328:     $Str .= "\n".'<table border=2>'.
  329:             "\n".'<tr>'.
  330:             "\n".'<th> # </th>'.
  331:             "\n".'<th> Concept </th>'.
  332:             "\n".'<th> Correct </th>'.
  333:             "\n".'<th> Wrong </th>'.
  334:             "\n".'</tr>';
  335: 
  336:     for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  337: 	$Str .= '<tr>'."\n";
  338:         $Str .= '<td>'.($n+1).'</td>'."\n";
  339:         my ($currentConcept) = split('::',$Concepts->[$n]);
  340:         $Str .= '<td bgcolor="EEFFCC">'.$currentConcept;
  341:         $Str .= '</td>'."\n";
  342:         $Str .= '<td bgcolor="DDFFDD">'.$data1[$n].'</td>'."\n";
  343:         $Str .= '<td bgcolor="FFDDDD">'.$data2[$n].'</td>'."\n";
  344:         $Str .= '</tr>'."\n";
  345:     }
  346:     $Str .= '<td></td><td><b>From:['.localtime($ConceptData->{'Int.'.$k});
  347:     $Str .= '] To: ['.localtime($ConceptData->{'Int.'.($k+1)}-1);
  348:     $Str .= ']</b></td><td>'.$Correct.'</td><td>'.$Wrong.'</td>';
  349:     $Str .= '</table>'."\n";
  350: 
  351:     return $Str;
  352: #$Apache::lonxml::debug=1;
  353: #&Apache::lonhomework::showhash(%ConceptData);
  354: #$Apache::lonxml::debug=0;
  355: }
  356: 
  357: #---- END Analyze Web Page ----------------------------------------------
  358: 
  359: sub Decide {
  360:     #deciding the true or false answer belongs to each interval
  361:     my ($type,$concept,$time,$ConceptData)=@_; 
  362:     my $k=0;
  363:     while($time > $ConceptData->{'Int.'.($k+1)} && 
  364:            $k < $ConceptData->{'Interval'}) {
  365:         $k++;
  366:     }
  367:     $ConceptData->{$concept.'.'.$k.'.'.$type}++;
  368: 
  369:     return;
  370: }
  371: 
  372: sub InitAnalysis {
  373:     my ($uri,$part,$responseId,$problem,$student,$courseID)=@_;
  374:     my ($name,$domain)=split(/\:/,$student);
  375: 
  376:     my %analyzeData;
  377:     # Render the student's view of the problem.  $Answ is the problem 
  378:     # Stringafied
  379:     my $Answ=&Apache::lonnet::ssi($uri,('grade_target'   => 'analyze',
  380:                                         'grade_username' => $name,
  381:                                         'grade_domain'   => $domain,
  382:                                         'grade_courseid' => $courseID,
  383:                                         'grade_symb'     => $problem));
  384:     my ($Answer)=&Apache::lonnet::str2hashref($Answ);
  385: 
  386:     my $found = 0;
  387:     my @parts=();
  388:     if(defined($responseId)) {
  389:         foreach (@{$Answer->{'parts'}}) {
  390:             if($_ eq $part.'.'.$responseId) {
  391:                 push(@parts, $_);
  392:                 $found = 1;
  393:                 last;
  394:             }
  395:         }
  396:     } else {
  397:         foreach (@{$Answer->{'parts'}}) {
  398:             if($_ =~ /$part/) {
  399:                 push(@parts, $_);
  400:                 $found = 1;
  401:                 last;
  402:             }
  403:         }
  404:     }
  405: 
  406:     if($found == 0) {
  407:         $analyzeData{'error'} = 'No parts matching selected values';
  408:         return \%analyzeData;
  409:     }
  410: 
  411:     my @Concepts=();
  412:     my %foil_to_concept;
  413:     foreach my $currentPart (@parts) {
  414:         if(defined($Answer->{$currentPart.'.concepts'})) {
  415:             foreach my $concept (@{$Answer->{$currentPart.'.concepts'}}) {
  416:                 push(@Concepts, $concept);
  417:                 foreach my $foil (@{$Answer->{$currentPart.'.concept.'.
  418:                                             $concept}}) {
  419:                     $analyzeData{$currentPart.'.foil.value.'.$foil} =
  420:                         $Answer->{$currentPart.'.foil.value.'.$foil};
  421:                     $foil_to_concept{$foil} = $concept;
  422:                 }
  423:             }
  424:         } else {
  425:             foreach (keys(%$Answer)) {
  426:                 if(/$currentPart.foil\.value\.(.*)$/) {
  427:                     push(@Concepts, $1);
  428:                     $foil_to_concept{$1} = $1;
  429:                     $analyzeData{$currentPart.'.foil.value.'.$1} =
  430:                         $Answer->{$currentPart.'.foil.value.'.$1};
  431:                 }
  432:             }
  433:         }
  434:     }
  435: 
  436:     $analyzeData{'parts'} = \@parts;
  437:     $analyzeData{'concepts'} = \@Concepts;
  438:     $analyzeData{'foil_to_concept'} = \%foil_to_concept;
  439: 
  440:     return \%analyzeData;
  441: }
  442: 
  443: sub Interval {
  444:     my ($part,$symb,$interval,$Concepts,$ConceptData)=@_;
  445:     my $Int=$interval;
  446:     my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb);
  447:     my $opn = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb);
  448:     my $add=int(($due-$opn)/$Int);
  449:     $ConceptData->{'Int.0'}=$opn;
  450:     for(my $i=1; $i<$Int; $i++) {
  451: 	$ConceptData->{'Int.'.$i}=$opn+$i*$add;
  452:     }
  453:     $ConceptData->{'Int.'.$Int}=$due;     
  454:     for(my $i=0; $i<$Int; $i++) {
  455: 	for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
  456: 	    my $tmp=$Concepts->[$n];
  457: 	    $ConceptData->{$tmp.'.'.$i.'.true'}=0;
  458: 	    $ConceptData->{$tmp.'.'.$i.'.false'}=0;
  459: 	}
  460:     }
  461: }
  462: 1;
  463: __END__

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