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

1.1       stredwic    1: # The LearningOnline Network with CAPA
                      2: #
1.27    ! matthew     3: # $Id: lonproblemanalysis.pm,v 1.26 2003/10/07 16:07:39 matthew Exp $
1.1       stredwic    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: 
1.11      minaeibi   28: package Apache::lonproblemanalysis;
1.1       stredwic   29: 
                     30: use strict;
                     31: use Apache::lonnet();
1.25      matthew    32: use Apache::loncommon();
1.7       stredwic   33: use Apache::lonhtmlcommon();
1.23      matthew    34: use Apache::loncoursedata();
                     35: use Apache::lonstatistics;
                     36: use Apache::lonlocal;
1.2       stredwic   37: 
1.1       stredwic   38: sub BuildProblemAnalysisPage {
1.23      matthew    39:     my ($r,$c)=@_;
1.24      matthew    40:     $r->print('<h2>'.&mt('Option Response Problem Analysis').'</h2>');
1.25      matthew    41:     $r->print(&CreateInterface());
1.23      matthew    42:     if (exists($ENV{'form.problemchoice'})) {
1.25      matthew    43:         $r->print('<hr />');
                     44:         &Apache::lonstatistics::Gather_Full_Student_Data($r);
1.23      matthew    45:         #
1.25      matthew    46:         my ($symb,$part,$resid) = &get_problem_symb(
1.23      matthew    47:                      &Apache::lonnet::unescape($ENV{'form.problemchoice'})
                     48:                                            );
                     49:         my $resource = &get_resource_from_symb($symb);
                     50:         if (defined($resource)) {
1.25      matthew    51:             my %Data = &get_problem_data($resource->{'src'});
                     52:             my $ORdata = $Data{$part.'.'.$resid};
                     53:             ##
1.26      matthew    54:             ## Render the problem
1.25      matthew    55:             my $base;
                     56:             ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
                     57:             $base = "http://".$ENV{'SERVER_NAME'}.$base;
1.26      matthew    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>'.
1.25      matthew    63:                       '<base href="'.$base.'" />'.
1.26      matthew    64:                       $rendered_problem.
                     65:                       '</td></tr></table>');
1.25      matthew    66:             ##
                     67:             ## Analyze the problem
1.26      matthew    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:             }
1.23      matthew    80:         } else {
                     81:             $r->print('resource is undefined');
1.7       stredwic   82:         }
1.23      matthew    83:         $r->print('<hr />');
1.25      matthew    84:     } else {
1.27    ! matthew    85:         $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
1.1       stredwic   86:     }
1.23      matthew    87:     # Okay, they asked for data, so make sure we get the latest data.
                     88:     $r->print(&OptionResponseProblemSelector());
1.1       stredwic   89: }
                     90: 
1.25      matthew    91: 
                     92: sub DoTriesAnalysis {
1.26      matthew    93:     my ($PerformanceData,$ORdata) = @_;
1.25      matthew    94:     my $mintries = 1;
                     95:     my $maxtries = 3;
1.26      matthew    96:     my %ResponseData = &analyze_option_data_by_tries($PerformanceData,
1.25      matthew    97:                                                  $mintries,$maxtries);
                     98:     my @Foils = sort(keys(%ResponseData));
                     99:     my %Row_Label;
                    100:     foreach my $foilid (@Foils) {
                    101:         my $value = $ORdata->{'Foiltext'}->{$foilid};
1.26      matthew   102: #        &Apache::lonnet::logthis('row label '.$foilid.' = '.$value);
1.25      matthew   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++) {
1.27    ! matthew   153:         my $minstu = $ResponseData{$Foils[0]}->[$i]->{'total'};
        !           154:         my $maxstu = $ResponseData{$Foils[0]}->[$i]->{'total'};
        !           155:         foreach my $foilid (@Foils) {
        !           156:             if ($minstu > $ResponseData{$foilid}->[$i]->{'total'}) {
        !           157:                 $minstu = $ResponseData{$foilid}->[$i]->{'total'};
        !           158:             }
        !           159:             if ($maxstu < $ResponseData{$foilid}->[$i]->{'total'}) {
        !           160:                 $maxstu = $ResponseData{$foilid}->[$i]->{'total'};
        !           161:             }
        !           162:         }
        !           163:         my $graphlink;
        !           164:         if ($maxstu == $minstu) {
        !           165:             $graphlink = &DrawGraph('Attempt '.$i.', '.$maxstu.' students',
        !           166:                                     'Foil Number',
        !           167:                                     'Percent Correct',
        !           168:                                     100,
        !           169:                                     $PlotData[$i]->{'good'},
        !           170:                                     $PlotData[$i]->{'bad'});
        !           171:         } else {
        !           172:             $graphlink = &DrawGraph('Attempt '.$i.', '.$minstu.'-'.$maxstu.
        !           173:                                     ' students',
        !           174:                                     'Foil Number',
        !           175:                                     'Percent Correct',
        !           176:                                     100,
        !           177:                                     $PlotData[$i]->{'good'},
        !           178:                                     $PlotData[$i]->{'bad'});
        !           179:         }
        !           180:         push(@Data,'<td colspan="3">'.$graphlink.'</td>');
1.25      matthew   181:     }
                    182:     push (@Rows,\@Data);
                    183:     my $table = '<table border="1" >'."\n";
                    184:     for (my $i=0; $i <=$#Rows;$i++) {
                    185:         $table .= '<tr>'.join('',@{$Rows[$i]})."</tr>\n";
                    186:     }
                    187:     $table .= '</table>';
                    188:     return ($table);
                    189: }
                    190: 
                    191: sub analyze_option_data_by_tries {
1.26      matthew   192:     my ($PerformanceData,$mintries,$maxtries) = @_;
1.25      matthew   193:     my %Trydata;
                    194:     $mintries = 1         if (! defined($mintries) || $mintries < 1);
                    195:     $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
1.26      matthew   196:     foreach my $row (@$PerformanceData) {
                    197:         next if (! defined($row));
1.25      matthew   198:         my ($grading,$submission,$time,$tries) = @$row;
                    199:         my @Foilgrades = split('&',$grading);
                    200:         my @Foilsubs   = split('&',$submission);
                    201:         for (my $numtries = 1; $numtries <= $maxtries; $numtries++) {
                    202:             if ($tries == $numtries) {
                    203:                 foreach my $foilgrade (@Foilgrades) {
                    204:                     my ($foilid,$correct) = split('=',$foilgrade);
                    205:                     if ($correct) {
                    206:                         $Trydata{$foilid}->[$numtries]->{'correct'}++;
                    207:                     } else {
                    208:                         $Trydata{$foilid}->[$numtries]->{'incorrect'}++;
                    209:                     }                        
                    210:                 }
                    211:             }
                    212:         }
                    213:     }
                    214:     foreach my $foilid (keys(%Trydata)) {
                    215:         foreach my $tryhash (@{$Trydata{$foilid}}) {
                    216:             next if ((! exists($tryhash->{'correct'}) && 
                    217:                       ! exists($tryhash->{'incorrect'})) ||
                    218:                      ($tryhash->{'correct'} < 1 &&
                    219:                       $tryhash->{'incorrect'} < 1));
1.27    ! matthew   220:             $tryhash->{'total'} = $tryhash->{'correct'} + 
        !           221:                                         $tryhash->{'incorrect'};
1.25      matthew   222:             $tryhash->{'percent_corr'} = 100 *
                    223:                 ($tryhash->{'correct'} /
                    224:                          ($tryhash->{'correct'} + $tryhash->{'incorrect'})
                    225:                  );
                    226:         }
                    227:     }
                    228:     return %Trydata;
                    229: }
                    230: 
                    231: sub DrawGraph {
                    232:     my ($title,$xlabel,$ylabel,$MaxY,$values1,$values2)=@_;
1.26      matthew   233:     if (! defined($values1) || ref($values1) ne 'ARRAY') {
                    234:         return '';
                    235:     }
1.25      matthew   236:     $title  = '' if (! defined($title));
                    237:     $xlabel = '' if (! defined($xlabel));
                    238:     $ylabel = '' if (! defined($ylabel));
                    239:     $title = &Apache::lonnet::escape($title);
                    240:     $xlabel = &Apache::lonnet::escape($xlabel);
                    241:     $ylabel = &Apache::lonnet::escape($ylabel);
                    242:     #
                    243:     my $sendValues1 = join(',', @$values1);
                    244:     my $sendValues2;
                    245:     if (defined($values2)) {
                    246:         $sendValues2 = join(',', @$values2);
                    247:     }
                    248:             
                    249:     my $sendCount = scalar(@$values1);
                    250:     $MaxY =1 if ($MaxY < 1);
                    251:     if ( int($MaxY) < $MaxY ) {
                    252:         $MaxY++;
                    253:         $MaxY = int($MaxY);
                    254:     }
                    255:     my @GData = ($title,$xlabel,$ylabel,$MaxY,$sendCount,$sendValues1);
                    256:     if (defined($sendValues2)) {
                    257:         push (@GData,$sendValues2);
                    258:     }
                    259:     return '<IMG src="/cgi-bin/graph.png?'.
                    260:         (join('&', @GData)).'" border="1" />';
                    261: }
                    262: 
                    263: 
                    264: 
1.23      matthew   265: sub get_problem_symb {
                    266:     my $problemstring = shift();
1.25      matthew   267:     my ($symb,$partid,$resid) = ($problemstring=~ /^(.*):([^:]*):([^:]*)$/);
                    268:     return ($symb,$partid,$resid);
1.1       stredwic  269: }
                    270: 
1.23      matthew   271: sub CreateInterface {
1.7       stredwic  272:     my $Str = '';
1.23      matthew   273:     $Str .= '<table cellspacing="5">'."\n";
                    274:     $Str .= '<tr>';
                    275:     $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
                    276:     $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
                    277:     $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
                    278:     $Str .= '</tr>'."\n";
                    279:     #
                    280:     $Str .= '<tr><td align="center">'."\n";
                    281:     $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
                    282:     $Str .= '</td><td align="center">';
                    283:     $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
                    284:     $Str .= '</td><td align="center">';
                    285:     my $only_seq_with_assessments = sub { 
                    286:         my $s=shift;
                    287:         if ($s->{'num_assess'} < 1) { 
                    288:             return 0;
                    289:         } else { 
                    290:             return 1;
                    291:         }
                    292:     };
                    293:     $Str .= &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
                    294:                                               $only_seq_with_assessments);
                    295:     $Str .= '</td></tr>'."\n";
                    296:     $Str .= '</table>'."\n";
                    297:     $Str .= '<input type="submit" name="ProblemAnalysis" value="'.
                    298:         &mt('Analyze Problem').'" />';
                    299:     $Str .= '&nbsp;'x5;
                    300:     $Str .= '<input type="submit" name="ClearCache" value="'.
                    301:         &mt('Clear Caches').'" />';
                    302:     $Str .= '&nbsp;'x5;
                    303:     return ($Str);
                    304: }
                    305: 
                    306: sub OptionResponseProblemSelector {
                    307:     my $Str;
                    308:     $Str = "\n<table>\n";
                    309:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
                    310:         next if ($seq->{'num_assess'}<1);
                    311:         my $seq_str = '';
                    312:         foreach my $res (@{$seq->{'contents'}}) {
                    313: #            &Apache::lonnet::logthis('checking '.$res->{'title'});
1.26      matthew   314:             next if ($res->{'type'} ne 'assessment');
1.23      matthew   315:             foreach my $part (@{$res->{'parts'}}) {
                    316:                 my $partdata = $res->{'partdata'}->{$part};
                    317:                 if (! exists($partdata->{'option'}) || 
                    318:                     $partdata->{'option'} == 0) {
                    319:                     next;
                    320:                 }
                    321:                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
                    322:                     my $respid = $partdata->{'ResponseIds'}->[$i];
                    323:                     my $resptype = $partdata->{'ResponseTypes'}->[$i];
                    324:                     if ($resptype eq 'option') {
1.25      matthew   325:                         my $value = &Apache::lonnet::escape($res->{'symb'}.':'.$part.':'.$respid);
1.23      matthew   326:                         my $checked = '';
                    327:                         if ($ENV{'form.problemchoice'} eq $value) {
                    328:                             $checked = 'checked ';
                    329:                         }
                    330:                         $seq_str .= '<tr><td>'.
                    331:   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
                    332:   '</td><td>'.
                    333:   '<a href="'.$res->{'src'}.'">'.$res->{'title'}.'</a> ';
                    334:                         if ($partdata->{'option'} > 1) {
                    335:                             $seq_str .= &mt('response').' '.$respid;
                    336:                         }
                    337:                         $seq_str .= "</td></tr>\n";
1.11      minaeibi  338:                     }
                    339:                 }
                    340:             }
                    341:         }
1.23      matthew   342:         if ($seq_str ne '') {
                    343:             $Str .= '<tr><td>&nbsp</td><td><b>'.$seq->{'title'}.'</b></td>'.
                    344:                 "</tr>\n".$seq_str;
                    345:         }
1.11      minaeibi  346:     }
1.23      matthew   347:     $Str .= "</table>\n";
                    348:     return $Str;
1.11      minaeibi  349: }
                    350: 
1.23      matthew   351: sub get_resource_from_symb {
                    352:     my ($symb) = @_;
                    353:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
                    354:         foreach my $res (@{$seq->{'contents'}}) {
                    355:             if ($res->{'symb'} eq $symb) {
                    356:                 return $res;
1.2       stredwic  357:             }
1.1       stredwic  358:         }
                    359:     }
1.23      matthew   360:     return undef;
1.1       stredwic  361: }
                    362: 
1.25      matthew   363: sub get_problem_data {
                    364:     my ($url) = @_;
                    365: #    my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze',
                    366: #                                  'grade_username' => $sname,
                    367: #                                  'grade_domain' => $sdom,
                    368: #                                  'grade_courseid' => $cid,
                    369: #                                  'grade_symb' => $symb));
                    370:     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
1.23      matthew   371:     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
1.25      matthew   372:     my %Answer;
1.23      matthew   373:     %Answer=&Apache::lonnet::str2hash($Answ);
1.25      matthew   374: #    &Apache::lonnet::logthis('keys of %Answer = '.join(', ',(keys(%Answer))));
                    375: #    &Apache::lonnet::logthis('$Answer{parts} = '.
                    376: #                             join(', ',@{$Answer{'parts'}}));
                    377:     my %Partdata;
                    378:     foreach my $part (@{$Answer{'parts'}}) {
                    379:         while (my($key,$value) = each(%Answer)) {
                    380:             next if ($key !~ /^$part/);
                    381:             $key =~ s/^$part\.//;
                    382:             if (ref($value) eq 'ARRAY') {
                    383:                 if ($key eq 'options') {
                    384:                     $Partdata{$part}->{'Options'}=$value;
                    385:                 } elsif ($key eq 'concepts') {
                    386:                     $Partdata{$part}->{'Concepts'}=$value;
                    387:                 } elsif ($key =~ /^concept\.(.*)$/) {
                    388:                     my $concept = $1;
                    389:                     foreach my $foil (@$value) {
                    390:                         $Partdata{$part}->{$foil}->{'Concept'}=$concept;
                    391:                     }
                    392:                 }
1.26      matthew   393:  #               &Apache::lonnet::logthis($part.' '.$key.' (array) = '.
                    394:  #                                        join(', ',@$value));
1.25      matthew   395:             } else {
                    396:                 $value =~ s/^\s*//g;
                    397:                 $value =~ s/\s*$//g;
                    398:                 if ($key=~ /^foil\.text\.(.*)$/) {
                    399:                     my $foil = $1;
                    400:                     $Partdata{$part}->{'Foiltext'}->{$foil}=$value;
                    401:                 } elsif ($key =~ /^foil\.value\.(.*)$/) {
                    402:                     my $foil = $1;
                    403:                     $Partdata{$part}->{'FoilValues'}->{$foil}=$value;
                    404:                 }
1.26      matthew   405: #                &Apache::lonnet::logthis($part.' '.$key.' = '.$value);
1.25      matthew   406:             }
                    407:         }
1.23      matthew   408:     }
                    409: 
1.25      matthew   410: #    my $parts='';
                    411: #    foreach my $elm (@{$Answer{"parts"}}) {
                    412: #        $parts.="$elm,";
                    413: #    }
                    414: #    chop($parts);
                    415: #    my $conc='';
                    416: #    foreach my $elm (@{$Answer{"$parts.concepts"}}) {
                    417: #        $conc.="$elm@";
                    418: #    }
                    419: #    chop($conc);
                    420: #
                    421: #    @Concepts=split(/\@/,$conc);
                    422: #    foreach my $concept (@{$Answer{"$parts.concepts"}}) {
                    423: #        foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
                    424: #            $foil_to_concept{$foil} = $concept;
                    425: #            #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
                    426: #        }
                    427: #    }
                    428: #    return $symb;
                    429:     return %Partdata;
1.1       stredwic  430: }
                    431: 
1.23      matthew   432: 1;
1.1       stredwic  433: 
                    434: __END__

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