File:  [LON-CAPA] / loncom / interface / statistics / lonproblemanalysis.pm
Revision 1.26: download - view: text, annotated - select for diffs
Tue Oct 7 16:07:39 2003 UTC (20 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Cleanups and added error checking to the entire module.  More is probably
needed.

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

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