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

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

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