Return to lonproblemanalysis.pm CVS log

Up to [LON-CAPA] / loncom / interface / statistics

Many changes, some large, some small.
Added 'tries' selection box, although it doesn't work yet and this
functionality will likely be changed signifigantly in the future.
Use loncommon::DrawGraph instead of our own DrawGraph.
Added proper handling of selected students, instead of always running
analysis on all students in the cache tables.

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonproblemanalysis.pm,v 1.28 2003/10/09 22:10:02 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: 
   28: package Apache::lonproblemanalysis;
   29: 
   30: use strict;
   31: use Apache::lonnet();
   32: use Apache::loncommon();
   33: use Apache::lonhtmlcommon();
   34: use Apache::loncoursedata();
   35: use Apache::lonstatistics;
   36: use Apache::lonlocal;
   37: 
   38: sub BuildProblemAnalysisPage {
   39:     my ($r,$c)=@_;
   40:     $r->print('<h2>'.&mt('Option Response Problem Analysis').'</h2>');
   41:     $r->print(&CreateInterface());
   42:     #
   43:     my @Students = @Apache::lonstatistics::Students;
   44:     #
   45:     if (exists($ENV{'form.problemchoice'})) {
   46:         $r->print('<hr />');
   47:         &Apache::lonstatistics::Gather_Full_Student_Data($r);
   48:         #
   49:         my ($symb,$part,$resid) = &get_problem_symb(
   50:                      &Apache::lonnet::unescape($ENV{'form.problemchoice'})
   51:                                            );
   52:         #
   53: #        my ($firsttime,$lasttime) = 
   54: #            &Apache::loncoursedata::get_timestamp_data($symb,$resid);
   55:         #
   56:         my $resource = &get_resource_from_symb($symb);
   57:         if (defined($resource)) {
   58:             my %Data = &get_problem_data($resource->{'src'});
   59:             my $ORdata = $Data{$part.'.'.$resid};
   60:             ##
   61:             ## Render the problem
   62:             my $base;
   63:             ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
   64:             $base = "http://".$ENV{'SERVER_NAME'}.$base;
   65:             my $rendered_problem = 
   66:                 &Apache::lonnet::ssi_body($resource->{'src'});
   67:             $rendered_problem =~ s/<form /<nop /g;
   68:             $rendered_problem =~ s/<\s*\/form\s>/<\/nop>/g;
   69:             $r->print('<table bgcolor="ffffff"><tr><td>'.
   70:                       '<base href="'.$base.'" />'.
   71:                       $rendered_problem.
   72:                       '</td></tr></table>');
   73:             ##
   74:             ## Analyze the problem
   75:             my $PerformanceData = 
   76:                 &Apache::loncoursedata::get_optionresponse_data
   77:                                            (\@Students,$symb,$resid);
   78:             if (defined($PerformanceData) && 
   79:                 ref($PerformanceData) eq 'ARRAY') {
   80:                 if ($ENV{'form.AnalyzeBy'} eq 'Tries') {
   81:                     my $analysis_html = &DoTriesAnalysis($PerformanceData,
   82:                                                          $ORdata);
   83:                 $r->print($analysis_html);
   84: #                } elsif ($ENV{'form.AnalyzeBy'} eq 'Time') {
   85: #                    my $analysis_html = &DoTimeAnalysis($PerformanceData,
   86: #                                                         $ORdata);
   87: #                $r->print($analysis_html);
   88:                 } else {
   89:                     $r->print('<h2>'.
   90:                               &mt('The analysis you have selected is '.
   91:                                          'not supported at this time').
   92:                               '</h2>');
   93:                 }
   94:             } else {
   95:                 $r->print('<h2>'.
   96:                           &mt('There is no student data for this problem.').
   97:                           '</h2>');
   98:             }
   99:         } else {
  100:             $r->print('resource is undefined');
  101:         }
  102:         $r->print('<hr />');
  103:     } else {
  104:         $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
  105:     }
  106:     # Okay, they asked for data, so make sure we get the latest data.
  107:     $r->print(&OptionResponseProblemSelector());
  108: }
  109: 
  110: 
  111: sub DoTriesAnalysis {
  112:     my ($PerformanceData,$ORdata) = @_;
  113:     my $mintries = 1;
  114:     my $maxtries = 10;
  115:     my %ResponseData = &analyze_option_data_by_tries($PerformanceData,
  116:                                                  $mintries,$maxtries);
  117:     my @Foils = sort(keys(%ResponseData));
  118:     my %Row_Label;
  119:     foreach my $foilid (@Foils) {
  120:         my $value = $ORdata->{'Foiltext'}->{$foilid};
  121: #        &Apache::lonnet::logthis('row label '.$foilid.' = '.$value);
  122:         $Row_Label{$foilid} = $ORdata->{'Foiltext'}->{$foilid};
  123:     }
  124:     my @Rows;
  125:     $Rows[0] = ['<td>&nbsp;</td>'];
  126:     for (my $i=$mintries;$i<=$maxtries;$i++) {
  127:         push (@{$Rows[0]},
  128:               '<th colspan="3">'.&mt('Attempt').' '.$i.'</th>');
  129:     }
  130:     $Rows[1] = ['<th>'.&mt('Foil').'</th>'];
  131:     for (my $i=$mintries;$i<=$maxtries;$i++) {
  132:         push (@{$Rows[1]},('<th>'.&mt('Correct').'</th>',
  133:                            '<th>'.&mt('Incorrect').'</th>',
  134:                            '<th>'.&mt('Percent Correct').'</th>',
  135:                            ));
  136:     }
  137:     my @PlotData;
  138:     my @CumulativePlotData;
  139:     my $index = 1;
  140:     foreach my $foilid (@Foils) {
  141:         my @Data = ('<td>'.$index.' '.$Row_Label{$foilid}.'</td>');
  142:         for (my $i=$mintries;$i<=$maxtries;$i++) {
  143:             push(@Data,
  144:                  ('<td>'.$ResponseData{$foilid}->[$i]->{'correct'}.'</td>',
  145:                   '<td>'.$ResponseData{$foilid}->[$i]->{'incorrect'}.
  146:                   '</td>',
  147:                   '<td>'.
  148:                   sprintf("%4.2f",
  149:                           $ResponseData{$foilid}->[$i]->{'percent_corr'}).
  150:                   '</td>'));
  151:             #
  152:             # Gather the per-attempt data
  153:             push (@{$PlotData[$i]->{'good'}},
  154:                   $ResponseData{$foilid}->[$i]->{'percent_corr'});
  155:             push (@{$PlotData[$i]->{'bad'}},
  156:                   100-$ResponseData{$foilid}->[$i]->{'percent_corr'});
  157:         }
  158:         for (my $i=0;$i<=$maxtries;$i++) {
  159:             push (@{$CumulativePlotData[$i]->{'good'}},
  160:                   $CumulativePlotData[-1]->{'good'}+
  161:                   $ResponseData{$foilid}->[$i]->{'correct'});
  162:             push (@{$CumulativePlotData[$i]->{'bad'}},
  163:                   $CumulativePlotData[-1]->{'bad'}+
  164:                   $ResponseData{$foilid}->[$i]->{'incorrect'});
  165:         }
  166:         push(@Rows,\@Data);
  167:     } continue {
  168:         $index++;
  169:     }
  170:     my @Data = ('<td></td>');
  171:     for (my $i=$mintries;$i<=$maxtries;$i++) {
  172:         my $minstu = $ResponseData{$Foils[0]}->[$i]->{'total'};
  173:         my $maxstu = $ResponseData{$Foils[0]}->[$i]->{'total'};
  174:         foreach my $foilid (@Foils) {
  175:             if ($minstu > $ResponseData{$foilid}->[$i]->{'total'}) {
  176:                 $minstu = $ResponseData{$foilid}->[$i]->{'total'};
  177:             }
  178:             if ($maxstu < $ResponseData{$foilid}->[$i]->{'total'}) {
  179:                 $maxstu = $ResponseData{$foilid}->[$i]->{'total'};
  180:             }
  181:         }
  182:         $maxstu = 0 if (! $maxstu);
  183:         $minstu = 0 if (! $minstu);
  184:         my $graphlink;
  185:         if ($maxstu == $minstu) {
  186:             $graphlink = &Apache::loncommon::DrawGraph
  187:                 ('Attempt '.$i.', '.$maxstu.' students',
  188:                  'Foil Number',
  189:                  'Percent Correct',
  190:                  100,
  191:                  $PlotData[$i]->{'good'},
  192:                  $PlotData[$i]->{'bad'});
  193:         } else {
  194:             $graphlink = &Apache::loncomon::DrawGraph
  195:                 ('Attempt '.$i.', '.$minstu.'-'.$maxstu.
  196:                  ' students',
  197:                  'Foil Number',
  198:                  'Percent Correct',
  199:                  100,
  200:                  $PlotData[$i]->{'good'},
  201:                  $PlotData[$i]->{'bad'});
  202:         }
  203:         push(@Data,'<td colspan="3">'.$graphlink.'</td>');
  204:     }
  205:     push (@Rows,\@Data);
  206:     my $table = '<table border="1" >'."\n";
  207:     for (my $i=0; $i <=$#Rows;$i++) {
  208:         $table .= '<tr>'.join('',@{$Rows[$i]})."</tr>\n";
  209:     }
  210:     $table .= '</table>';
  211:     return ($table);
  212: }
  213: 
  214: sub analyze_option_data_by_tries {
  215:     my ($PerformanceData,$mintries,$maxtries) = @_;
  216:     my %Trydata;
  217:     $mintries = 1         if (! defined($mintries) || $mintries < 1);
  218:     $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
  219:     foreach my $row (@$PerformanceData) {
  220:         next if (! defined($row));
  221:         my ($grading,$submission,$time,$tries) = @$row;
  222:         my @Foilgrades = split('&',$grading);
  223:         my @Foilsubs   = split('&',$submission);
  224:         for (my $numtries = 1; $numtries <= $maxtries; $numtries++) {
  225:             if ($tries == $numtries) {
  226:                 foreach my $foilgrade (@Foilgrades) {
  227:                     my ($foilid,$correct) = split('=',$foilgrade);
  228:                     if ($correct) {
  229:                         $Trydata{$foilid}->[$numtries]->{'correct'}++;
  230:                     } else {
  231:                         $Trydata{$foilid}->[$numtries]->{'incorrect'}++;
  232:                     }                        
  233:                 }
  234:             }
  235:         }
  236:     }
  237:     foreach my $foilid (keys(%Trydata)) {
  238:         foreach my $tryhash (@{$Trydata{$foilid}}) {
  239:             next if ((! exists($tryhash->{'correct'}) && 
  240:                       ! exists($tryhash->{'incorrect'})) ||
  241:                      ($tryhash->{'correct'} < 1 &&
  242:                       $tryhash->{'incorrect'} < 1));
  243:             $tryhash->{'total'} = $tryhash->{'correct'} + 
  244:                                         $tryhash->{'incorrect'};
  245:             $tryhash->{'percent_corr'} = 100 *
  246:                 ($tryhash->{'correct'} /
  247:                          ($tryhash->{'correct'} + $tryhash->{'incorrect'})
  248:                  );
  249:         }
  250:     }
  251:     return %Trydata;
  252: }
  253: 
  254: sub get_problem_symb {
  255:     my $problemstring = shift();
  256:     my ($symb,$partid,$resid) = ($problemstring=~ /^(.*):([^:]*):([^:]*)$/);
  257:     return ($symb,$partid,$resid);
  258: }
  259: 
  260: sub CreateInterface {
  261:     ##
  262:     ## Environment variable initialization
  263:     if (! exists$ENV{'form.AnalyzeBy'}) {
  264:         $ENV{'form.AnalyzeBy'} = 'Tries';
  265:     }
  266:     ##
  267:     ## Build the menu
  268:     my $Str = '';
  269:     $Str .= '<table cellspacing="5">'."\n";
  270:     $Str .= '<tr>';
  271:     $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
  272:     $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
  273:     $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
  274:     $Str .= '<td align="center"><b>'.&mt('Analyze By').'</b></td>';
  275:     $Str .= '</tr>'."\n";
  276:     #
  277:     $Str .= '<tr><td align="center">'."\n";
  278:     $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
  279:     $Str .= '</td>';
  280:     #
  281:     $Str .= '<td align="center">';
  282:     $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
  283:     $Str .= '</td>';
  284:     #
  285:     $Str .= '<td align="center">';
  286:     my $only_seq_with_assessments = sub { 
  287:         my $s=shift;
  288:         if ($s->{'num_assess'} < 1) { 
  289:             return 0;
  290:         } else { 
  291:             return 1;
  292:         }
  293:     };
  294:     $Str .= &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
  295:                                               $only_seq_with_assessments);
  296:     $Str .= '</td>';
  297:     #
  298:     $Str .= '<td>';
  299:     $Str .='<input type="radio" name="AnalyzeBy" value="Tries" ';
  300:     if ($ENV{'form.AnalyzeBy'} eq 'Tries') {
  301:         $Str .= 'checked ';
  302:     }
  303:     $Str .= '>'.&mt('Tries').'<br />';
  304:     $Str .='<input type="radio" name="AnalyzeBy" value="Time" ';
  305:     if ($ENV{'form.AnalyzeBy'} eq 'Time') {
  306:         $Str .= 'checked ';
  307:     }
  308:     $Str .= '>'.&mt('Time').'<br />';
  309:     $Str .= '</td>';
  310:     #
  311:     $Str .= '</tr>'."\n";
  312:     $Str .= '</table>'."\n";
  313:     $Str .= '<input type="submit" name="ProblemAnalysis" value="'.
  314:         &mt('Analyze Problem').'" />';
  315:     $Str .= '&nbsp;'x5;
  316:     $Str .= '<input type="submit" name="ClearCache" value="'.
  317:         &mt('Clear Caches').'" />';
  318:     $Str .= '&nbsp;'x5;
  319:     return ($Str);
  320: }
  321: 
  322: sub OptionResponseProblemSelector {
  323:     my $Str;
  324:     $Str = "\n<table>\n";
  325:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
  326:         next if ($seq->{'num_assess'}<1);
  327:         my $seq_str = '';
  328:         foreach my $res (@{$seq->{'contents'}}) {
  329: #            &Apache::lonnet::logthis('checking '.$res->{'title'});
  330:             next if ($res->{'type'} ne 'assessment');
  331:             foreach my $part (@{$res->{'parts'}}) {
  332:                 my $partdata = $res->{'partdata'}->{$part};
  333:                 if (! exists($partdata->{'option'}) || 
  334:                     $partdata->{'option'} == 0) {
  335:                     next;
  336:                 }
  337:                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
  338:                     my $respid = $partdata->{'ResponseIds'}->[$i];
  339:                     my $resptype = $partdata->{'ResponseTypes'}->[$i];
  340:                     if ($resptype eq 'option') {
  341:                         my $value = &Apache::lonnet::escape($res->{'symb'}.':'.$part.':'.$respid);
  342:                         my $checked = '';
  343:                         if ($ENV{'form.problemchoice'} eq $value) {
  344:                             $checked = 'checked ';
  345:                         }
  346:                         $seq_str .= '<tr><td>'.
  347:   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
  348:   '</td><td>'.
  349:   '<a href="'.$res->{'src'}.'">'.$res->{'title'}.'</a> ';
  350:                         if ($partdata->{'option'} > 1) {
  351:                             $seq_str .= &mt('response').' '.$respid;
  352:                         }
  353:                         $seq_str .= "</td></tr>\n";
  354:                     }
  355:                 }
  356:             }
  357:         }
  358:         if ($seq_str ne '') {
  359:             $Str .= '<tr><td>&nbsp</td><td><b>'.$seq->{'title'}.'</b></td>'.
  360:                 "</tr>\n".$seq_str;
  361:         }
  362:     }
  363:     $Str .= "</table>\n";
  364:     return $Str;
  365: }
  366: 
  367: sub get_resource_from_symb {
  368:     my ($symb) = @_;
  369:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
  370:         foreach my $res (@{$seq->{'contents'}}) {
  371:             if ($res->{'symb'} eq $symb) {
  372:                 return $res;
  373:             }
  374:         }
  375:     }
  376:     return undef;
  377: }
  378: 
  379: sub get_problem_data {
  380:     my ($url) = @_;
  381: #    my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze',
  382: #                                  'grade_username' => $sname,
  383: #                                  'grade_domain' => $sdom,
  384: #                                  'grade_courseid' => $cid,
  385: #                                  'grade_symb' => $symb));
  386:     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
  387:     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
  388:     my %Answer;
  389:     %Answer=&Apache::lonnet::str2hash($Answ);
  390: #    &Apache::lonnet::logthis('keys of %Answer = '.join(', ',(keys(%Answer))));
  391: #    &Apache::lonnet::logthis('$Answer{parts} = '.
  392: #                             join(', ',@{$Answer{'parts'}}));
  393:     my %Partdata;
  394:     foreach my $part (@{$Answer{'parts'}}) {
  395:         while (my($key,$value) = each(%Answer)) {
  396:             next if ($key !~ /^$part/);
  397:             $key =~ s/^$part\.//;
  398:             if (ref($value) eq 'ARRAY') {
  399:                 if ($key eq 'options') {
  400:                     $Partdata{$part}->{'Options'}=$value;
  401:                 } elsif ($key eq 'concepts') {
  402:                     $Partdata{$part}->{'Concepts'}=$value;
  403:                 } elsif ($key =~ /^concept\.(.*)$/) {
  404:                     my $concept = $1;
  405:                     foreach my $foil (@$value) {
  406:                         $Partdata{$part}->{$foil}->{'Concept'}=$concept;
  407:                     }
  408:                 }
  409:  #               &Apache::lonnet::logthis($part.' '.$key.' (array) = '.
  410:  #                                        join(', ',@$value));
  411:             } else {
  412:                 $value =~ s/^\s*//g;
  413:                 $value =~ s/\s*$//g;
  414:                 if ($key=~ /^foil\.text\.(.*)$/) {
  415:                     my $foil = $1;
  416:                     $Partdata{$part}->{'Foiltext'}->{$foil}=$value;
  417:                 } elsif ($key =~ /^foil\.value\.(.*)$/) {
  418:                     my $foil = $1;
  419:                     $Partdata{$part}->{'FoilValues'}->{$foil}=$value;
  420:                 }
  421: #                &Apache::lonnet::logthis($part.' '.$key.' = '.$value);
  422:             }
  423:         }
  424:     }
  425: 
  426: #    my $parts='';
  427: #    foreach my $elm (@{$Answer{"parts"}}) {
  428: #        $parts.="$elm,";
  429: #    }
  430: #    chop($parts);
  431: #    my $conc='';
  432: #    foreach my $elm (@{$Answer{"$parts.concepts"}}) {
  433: #        $conc.="$elm@";
  434: #    }
  435: #    chop($conc);
  436: #
  437: #    @Concepts=split(/\@/,$conc);
  438: #    foreach my $concept (@{$Answer{"$parts.concepts"}}) {
  439: #        foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
  440: #            $foil_to_concept{$foil} = $concept;
  441: #            #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
  442: #        }
  443: #    }
  444: #    return $symb;
  445:     return %Partdata;
  446: }
  447: 
  448: 1;
  449: 
  450: __END__