File:  [LON-CAPA] / loncom / interface / statistics / lonproblemanalysis.pm
Revision 1.32: download - view: text, annotated - select for diffs
Fri Oct 10 21:49:20 2003 UTC (20 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Put those headers on the table and not in some random array....

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

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