Annotation of loncom/interface/statistics/lonproblemanalysis.pm, revision 1.5

1.1       stredwic    1: # The LearningOnline Network with CAPA
                      2: # (Publication Handler
                      3: #
1.5     ! stredwic    4: # $Id: lonproblemanalysis.pm,v 1.4 2002/08/05 20:53:38 stredwic Exp $
1.1       stredwic    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: 
1.5     ! stredwic   44: my $jr;
1.2       stredwic   45: 
1.1       stredwic   46: sub BuildProblemAnalysisPage {
1.4       stredwic   47:     my ($cacheDB, $r)=@_;
1.1       stredwic   48: 
                     49:     my %cache;
1.3       stredwic   50:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
1.4       stredwic   51:         $r->print('<html><body>Unable to tie database.</body></html>');
                     52:         return;
1.1       stredwic   53:     }
                     54: 
1.4       stredwic   55:     $r->print(&IntervalOptions($cache{'Interval'}));
                     56:     $r->rflush();
                     57:     $r->print(&OptionResponseTable($cache{'OptionResponses'}, \%cache));
1.1       stredwic   58: 
                     59:     untie(%cache);
                     60: 
1.4       stredwic   61:     return;
1.1       stredwic   62: }
                     63: 
                     64: sub BuildAnalyzePage {
1.2       stredwic   65:     my ($cacheDB, $students, $courseID,$r)=@_;
                     66: 
1.5     ! stredwic   67:     $jr = $r;
1.2       stredwic   68:     my $c = $r->connection;
1.1       stredwic   69: 
1.2       stredwic   70:     my $Str = '</form>';
1.1       stredwic   71:     my %cache;
1.5     ! stredwic   72:     if(&Apache::loncoursedata::DownloadStudentCourseDataSeparate($students, 'true', 
        !            73:                                                                  $cacheDB, 'true', 
        !            74:                                                                  'true', $courseID, 
        !            75:                                                                  $r, $c) ne 'OK') {
        !            76:         $r->print($Str);
        !            77:         return;
1.2       stredwic   78:     }
1.5     ! stredwic   79: 
1.2       stredwic   80: 
1.3       stredwic   81:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
1.1       stredwic   82:         $Str .= '<html><body>Unable to tie database.</body></html>';
1.5     ! stredwic   83:         $r->print($Str);
        !            84:         return;
1.1       stredwic   85:     }
                     86: 
1.2       stredwic   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'};
1.1       stredwic   92: 
                     93:     my %ConceptData;
                     94:     $ConceptData{"Interval"} = $interval;
                     95: 
                     96:     #Initialize the option response true answers
1.2       stredwic   97:     my ($analyzeData) = &InitAnalysis($uri, $part, $responseId, $problem, 
                     98:                                       $students->[0], $courseID);
                     99:     if(defined($analyzeData->{'error'})) {
1.5     ! stredwic  100:         $Str .= $analyzeData->{'error'}.'<br>Incorrect part requested.<br>';
        !           101:         $r->print($Str);
        !           102:         return;
1.2       stredwic  103:     }
1.1       stredwic  104: 
1.5     ! stredwic  105:     $r->print($Str);
        !           106:     $Str = '';
        !           107:     if($c->aborted()) {  untie(%cache); return; }
1.3       stredwic  108: 
1.1       stredwic  109:     #compute the intervals
1.2       stredwic  110:     &Interval($part, $problem, $interval, $analyzeData->{'concepts'}, 
                    111:               \%ConceptData);
1.1       stredwic  112: 
                    113:     $title =~ s/\ /"_"/eg;
                    114:     $Str .= '<br><b>'.$uri.'</b>';
1.3       stredwic  115: 
1.5     ! stredwic  116:     $r->print($Str);
        !           117:     $Str = '';
        !           118:     if($c->aborted()) {  untie(%cache); return; }
1.1       stredwic  119:          
                    120:     #Java script Progress window
1.2       stredwic  121:     for(my $index=0; $index<(scalar @$students); $index++) {
1.5     ! stredwic  122:         if($c->aborted()) {  untie(%cache); return; }
        !           123: 	&OpStatus($problemId, $students->[$index], \%ConceptData, 
1.2       stredwic  124:                   $analyzeData->{'foil_to_concept'}, $analyzeData, \%cache);
1.1       stredwic  125:     }
                    126: 
                    127:     $Str .= '<br>';
                    128:     for (my $k=0; $k<$interval; $k++ ) {
1.3       stredwic  129:         if($c->aborted()) {  untie(%cache); return $Str; }
1.2       stredwic  130: 	$Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'}, 
                    131:                            \%ConceptData);
1.5     ! stredwic  132:         $r->print($Str);
        !           133:         $Str = '';
1.1       stredwic  134:     }
                    135:     for (my $k=0; $k<$interval; $k++ ) {
1.3       stredwic  136:         if($c->aborted()) {  untie(%cache); return $Str; }
1.2       stredwic  137: 	$Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData);
1.5     ! stredwic  138:         $r->print($Str);
        !           139:         $Str = '';
1.1       stredwic  140:     }
                    141:     my $Answ=&Apache::lonnet::ssi($uri);
                    142:     $Str .= '<br><b>Here you can see the Problem:</b><br>'.$Answ;
1.5     ! stredwic  143:     $Str .= '<form>';
        !           144:     $r->print($Str);
1.1       stredwic  145: 
                    146:     untie(%cache);
                    147: 
1.5     ! stredwic  148:     return;
1.1       stredwic  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 {
1.2       stredwic  178:     my ($optionResponses,$cache)=@_;
1.1       stredwic  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;
1.2       stredwic  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: 
1.1       stredwic  198:         my $Temp = '<a href="'.$uri.'" target="_blank">'.$title.'</a>';
                    199:         $Str .= '<tr>';
                    200:         $Str .= '<td> '.$number.' </td>';
1.2       stredwic  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:         }
1.1       stredwic  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 {
1.5     ! stredwic  226:     my ($problemID, $student, $ConceptData, $foil_to_concept, 
1.2       stredwic  227:         $analyzeData, $cache)=@_;
                    228: 
                    229:     my $ids = $analyzeData->{'parts'};
1.1       stredwic  230:     my @True = ();
                    231:     my @False = ();
                    232:     my $flag=0;
1.2       stredwic  233: 
                    234:     my $tries=0;
                    235: 
1.5     ! stredwic  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) {
1.2       stredwic  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:             }
1.1       stredwic  256:         }
                    257:     }
1.2       stredwic  258: 
                    259:     return;
1.1       stredwic  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";
1.2       stredwic  339:         my ($currentConcept) = split('::',$Concepts->[$n]);
                    340:         $Str .= '<td bgcolor="EEFFCC">'.$currentConcept;
1.1       stredwic  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;
1.2       stredwic  363:     while($time > $ConceptData->{'Int.'.($k+1)} && 
                    364:            $k < $ConceptData->{'Interval'}) {
                    365:         $k++;
                    366:     }
1.1       stredwic  367:     $ConceptData->{$concept.'.'.$k.'.'.$type}++;
                    368: 
                    369:     return;
                    370: }
                    371: 
                    372: sub InitAnalysis {
1.2       stredwic  373:     my ($uri,$part,$responseId,$problem,$student,$courseID)=@_;
1.1       stredwic  374:     my ($name,$domain)=split(/\:/,$student);
                    375: 
1.2       stredwic  376:     my %analyzeData;
1.1       stredwic  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));
1.5     ! stredwic  384:     my ($a)=&Apache::lonnet::str2hashref($Answ);
        !           385:     my %b;
        !           386:     foreach (keys(%$a)) {
        !           387:         $b{&Apache::lonnet::unescape($_)} = $a->{$_};
        !           388:     }
        !           389:     my $Answer=\%b;
1.1       stredwic  390: 
1.2       stredwic  391:     my $found = 0;
                    392:     my @parts=();
                    393:     if(defined($responseId)) {
1.5     ! stredwic  394:         foreach (@{$Answer->{'parts'}}) {
1.2       stredwic  395:             if($_ eq $part.'.'.$responseId) {
                    396:                 push(@parts, $_);
                    397:                 $found = 1;
                    398:                 last;
                    399:             }
                    400:         }
                    401:     } else {
1.5     ! stredwic  402:         foreach (@{$Answer->{'parts'}}) {
1.2       stredwic  403:             if($_ =~ /$part/) {
                    404:                 push(@parts, $_);
                    405:                 $found = 1;
                    406:                 last;
                    407:             }
                    408:         }
1.1       stredwic  409:     }
                    410: 
1.2       stredwic  411:     if($found == 0) {
                    412:         $analyzeData{'error'} = 'No parts matching selected values';
                    413:         return \%analyzeData;
1.1       stredwic  414:     }
                    415: 
1.2       stredwic  416:     my @Concepts=();
1.1       stredwic  417:     my %foil_to_concept;
1.2       stredwic  418:     foreach my $currentPart (@parts) {
1.5     ! stredwic  419:         if(defined($Answer->{$currentPart.'.concepts'})) {
        !           420:             foreach my $concept (@{$Answer->{$currentPart.'.concepts'}}) {
1.2       stredwic  421:                 push(@Concepts, $concept);
1.5     ! stredwic  422:                 foreach my $foil (@{$Answer->{$currentPart.'.concept.'.
1.2       stredwic  423:                                             $concept}}) {
                    424:                     $analyzeData{$currentPart.'.foil.value.'.$foil} =
1.5     ! stredwic  425:                         $Answer->{$currentPart.'.foil.value.'.$foil};
1.2       stredwic  426:                     $foil_to_concept{$foil} = $concept;
                    427:                 }
                    428:             }
                    429:         } else {
1.5     ! stredwic  430:             foreach (keys(%$Answer)) {
1.2       stredwic  431:                 if(/$currentPart.foil\.value\.(.*)$/) {
                    432:                     push(@Concepts, $1);
                    433:                     $foil_to_concept{$1} = $1;
                    434:                     $analyzeData{$currentPart.'.foil.value.'.$1} =
1.5     ! stredwic  435:                         $Answer->{$currentPart.'.foil.value.'.$1};
1.2       stredwic  436:                 }
                    437:             }
                    438:         }
1.1       stredwic  439:     }
                    440: 
1.2       stredwic  441:     $analyzeData{'parts'} = \@parts;
                    442:     $analyzeData{'concepts'} = \@Concepts;
                    443:     $analyzeData{'foil_to_concept'} = \%foil_to_concept;
                    444: 
                    445:     return \%analyzeData;
1.1       stredwic  446: }
                    447: 
                    448: sub Interval {
                    449:     my ($part,$symb,$interval,$Concepts,$ConceptData)=@_;
                    450:     my $Int=$interval;
                    451:     my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb);
                    452:     my $opn = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb);
                    453:     my $add=int(($due-$opn)/$Int);
                    454:     $ConceptData->{'Int.0'}=$opn;
1.2       stredwic  455:     for(my $i=1; $i<$Int; $i++) {
1.1       stredwic  456: 	$ConceptData->{'Int.'.$i}=$opn+$i*$add;
                    457:     }
                    458:     $ConceptData->{'Int.'.$Int}=$due;     
1.2       stredwic  459:     for(my $i=0; $i<$Int; $i++) {
                    460: 	for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
1.1       stredwic  461: 	    my $tmp=$Concepts->[$n];
                    462: 	    $ConceptData->{$tmp.'.'.$i.'.true'}=0;
                    463: 	    $ConceptData->{$tmp.'.'.$i.'.false'}=0;
                    464: 	}
                    465:     }
                    466: }
                    467: 1;
                    468: __END__

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