Annotation of loncom/interface/statistics/lonstathelpers.pm, revision 1.3

1.1       matthew     1: # The LearningOnline Network with CAPA
                      2: #
1.3     ! matthew     3: # $Id: lonstathelpers.pm,v 1.2 2004/01/20 15:51:06 matthew Exp $
1.1       matthew     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: ####################################################
                     29: 
                     30: =pod
                     31: 
                     32: =head1 NAME
                     33: 
                     34: Apache::lonstathelpers - helper routines used by statistics
                     35: 
                     36: =head1 SYNOPSIS
                     37: 
                     38: This module provides a place to consolidate much of the statistics 
                     39: routines that are needed across multiple statistics functions.
                     40: 
                     41: =head1 OVERVIEW
                     42: 
                     43: 
                     44: =over 4
                     45: 
                     46: =cut
                     47: 
                     48: ####################################################
                     49: ####################################################
                     50: package Apache::lonstathelpers;
                     51: 
                     52: use strict;
                     53: use Apache::lonnet();
                     54: use Apache::loncommon();
                     55: use Apache::lonhtmlcommon();
                     56: use Apache::loncoursedata();
                     57: use Apache::lonstatistics;
                     58: use Apache::lonlocal;
                     59: use HTML::Entities();
                     60: use Time::Local();
                     61: use Spreadsheet::WriteExcel();
                     62: 
                     63: ####################################################
                     64: ####################################################
                     65: 
                     66: =pod
                     67: 
                     68: =item &render_resource($resource)
                     69: 
                     70: Input: a resource generated from 
                     71: &Apache::loncoursedata::get_sequence_assessment_data().
                     72: 
                     73: Retunrs: a scalar containing html for a rendering of the problem
                     74: within a table.
                     75: 
                     76: =cut
                     77: 
                     78: ####################################################
                     79: ####################################################
                     80: sub render_resource {
                     81:     my ($resource) = @_;
                     82:     ##
                     83:     ## Render the problem
                     84:     my $base;
                     85:     ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
                     86:     $base = "http://".$ENV{'SERVER_NAME'}.$base;
                     87:     my $rendered_problem = 
                     88:         &Apache::lonnet::ssi_body($resource->{'src'});
                     89:     $rendered_problem =~ s/<\s*form\s*/<nop /g;
                     90:     $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;
                     91:     return '<table bgcolor="ffffff"><tr><td>'.
                     92:         '<base href="'.$base.'" />'.
                     93:         $rendered_problem.
                     94:         '</td></tr></table>';
                     95: }
1.2       matthew    96: 
                     97: ####################################################
                     98: ####################################################
                     99: 
                    100: =pod
                    101: 
                    102: =item &ProblemSelector($AcceptedResponseTypes)
                    103: 
                    104: Input: scalar containing regular expression which matches response
                    105: types to show.  '.' will yield all, '(option|radiobutton)' will match
                    106: all option response and radiobutton problems.
                    107: 
                    108: Returns: A string containing html for a table which lists the sequences
                    109: and their contents.  A radiobutton is provided for each problem.
                    110: 
                    111: =cut
                    112: 
                    113: ####################################################
                    114: ####################################################
                    115: sub ProblemSelector {
                    116:     my ($AcceptedResponseTypes) = @_;
                    117:     my $Str;
                    118:     $Str = "\n<table>\n";
                    119:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
                    120:         next if ($seq->{'num_assess'}<1);
                    121:         my $seq_str = '';
                    122:         foreach my $res (@{$seq->{'contents'}}) {
                    123:             next if ($res->{'type'} ne 'assessment');
                    124:             foreach my $part (@{$res->{'parts'}}) {
                    125:                 my $partdata = $res->{'partdata'}->{$part};
                    126:                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
                    127:                     my $respid = $partdata->{'ResponseIds'}->[$i];
                    128:                     my $resptype = $partdata->{'ResponseTypes'}->[$i];
                    129:                     if ($resptype =~ m/$AcceptedResponseTypes/) {
                    130:                         my $value = &make_target_id({symb=>$res->{'symb'},
                    131:                                                      part=>$part,
                    132:                                                      respid=>$respid,
                    133:                                                      resptype=>$resptype});
                    134:                         my $checked = '';
                    135:                         if ($ENV{'form.problemchoice'} eq $value) {
                    136:                             $checked = 'checked ';
                    137:                         }
                    138:                         my $title = $res->{'title'};
                    139:                         if (! defined($title) || $title eq '') {
                    140:                             ($title) = ($res->{'src'} =~ m:/([^/]*)$:);
                    141:                         }
                    142:                         $seq_str .= '<tr><td>'.
                    143:   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
                    144:   '</td><td>'.          
                    145:   $resptype.'</td><td>'.
                    146:   '<a href="'.$res->{'src'}.'">'.$title.'</a> ';
                    147: #  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';
                    148:                         if ($partdata->{'option'} > 1) {
                    149:                             $seq_str .= &mt('response').' '.$respid;
                    150:                         }
                    151:                         $seq_str .= "</td></tr>\n";
                    152:                     }
                    153:                 }
                    154:             }
                    155:         }
                    156:         if ($seq_str ne '') {
                    157:             $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'.
                    158:                 "</tr>\n".$seq_str;
                    159:         }
                    160:     }
                    161:     $Str .= "</table>\n";
                    162:     return $Str;
                    163: }
                    164: 
                    165: ####################################################
                    166: ####################################################
                    167: 
                    168: =pod
                    169: 
                    170: =item &make_target_id($target)
                    171: 
                    172: Inputs: Hash ref with the following entries:
                    173:     $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
                    174:     $target->{'resptype'}.
                    175: 
                    176: Returns: A string, suitable for a form parameter, which uniquely identifies
                    177: the problem, part, and response to do statistical analysis on.
                    178: 
                    179: Used by Apache::lonstathelpers::ProblemSelector().
                    180: 
                    181: =cut
                    182: 
                    183: ####################################################
                    184: ####################################################
                    185: sub make_target_id {
                    186:     my ($target) = @_;
                    187:     my $id = &Apache::lonnet::escape($target->{'symb'}).':'.
                    188:              &Apache::lonnet::escape($target->{'part'}).':'.
                    189:              &Apache::lonnet::escape($target->{'respid'}).':'.
                    190:              &Apache::lonnet::escape($target->{'resptype'});
                    191:     return $id;
                    192: }
                    193: 
                    194: ####################################################
                    195: ####################################################
                    196: 
                    197: =pod
                    198: 
                    199: =item &get_target_from_id($id)
                    200: 
                    201: Inputs: $id, a scalar string from Apache::lonstathelpers::make_target_id().
                    202: 
                    203: Returns: A hash reference, $target, containing the following keys:
                    204:     $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
                    205:     $target->{'resptype'}.
                    206: 
                    207: =cut
                    208: 
                    209: ####################################################
                    210: ####################################################
                    211: sub get_target_from_id {
                    212:     my ($id) = @_;
                    213:     my ($symb,$part,$respid,$resptype) = split(':',$id);
                    214:     return ({ symb    =>&Apache::lonnet::unescape($symb),
                    215:              part     =>&Apache::lonnet::unescape($part),
                    216:              respid   =>&Apache::lonnet::unescape($respid),
                    217:              resptype =>&Apache::lonnet::unescape($resptype)});
                    218: }
                    219: 
                    220: ####################################################
                    221: ####################################################
                    222: 
                    223: =pod
                    224: 
                    225: =item &get_prev_curr_next($target)
                    226: 
                    227: Determine the problem parts or responses preceeding and following the
                    228: current resource.
                    229: 
                    230: Inputs: $target (see &Apache::lonstathelpers::get_target_from_id())
                    231:   $AcceptableResponseTypes, regular expression matching acceptable
                    232:                             response types,
                    233:   $granularity, either 'part' or 'response'
                    234: 
                    235: Returns: three hash references, $prev, $curr, $next, which refer to the
                    236: preceeding, current, or following problem parts or responses, depending
                    237: on the value of $granularity.  Values of undef indicate there is no
                    238: previous or next part/response.  A value of undef for all three indicates
                    239: there was no match found to the current part/resource.
                    240: 
                    241: The hash references contain the following keys:
                    242:     symb, part, resource
                    243: 
                    244: If $granularity eq 'response', the following ADDITIONAL keys will be present:
                    245:     respid, resptype
                    246: 
                    247: =cut
                    248: 
                    249: ####################################################
                    250: ####################################################
                    251: sub get_prev_curr_next {
                    252:     my ($target,$AcceptableResponseTypes,$granularity) = @_;
                    253:     #
                    254:     # Build an array with the data we need to search through
                    255:     my @Resource;
                    256:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
                    257:         foreach my $res (@{$seq->{'contents'}}) {
                    258:             next if ($res->{'type'} ne 'assessment');
                    259:             foreach my $part (@{$res->{'parts'}}) {
                    260:                 my $partdata = $res->{'partdata'}->{$part};
                    261:                 if ($granularity eq 'part') {
                    262:                     push (@Resource,
                    263:                           { symb     => $res->{symb},
                    264:                             part     => $part,
                    265:                             resource => $res,
                    266:                         } );
                    267:                 } elsif ($granularity eq 'response') {
                    268:                     for (my $i=0;
                    269:                          $i<scalar(@{$partdata->{'ResponseTypes'}});
                    270:                          $i++){
                    271:                         my $respid = $partdata->{'ResponseIds'}->[$i];
                    272:                         my $resptype = $partdata->{'ResponseTypes'}->[$i];
                    273:                         next if ($resptype !~ m/$AcceptableResponseTypes/);
                    274:                         push (@Resource,
                    275:                               { symb     => $res->{symb},
                    276:                                 part     => $part,
                    277:                                 respid   => $partdata->{'ResponseIds'}->[$i],
                    278:                                 resource => $res,
                    279:                                 resptype => $resptype
                    280:                                 } );
                    281:                     }
                    282:                 }
                    283:             }
                    284:         }
                    285:     }
                    286:     #
                    287:     # Get the index of the current situation
                    288:     my $curr_idx;
                    289:     for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {
                    290:         my $curr_item = $Resource[$curr_idx];
                    291:         if ($granularity eq 'part') {
                    292:             if ($curr_item->{'symb'} eq $target->{'symb'} &&
                    293:                 $curr_item->{'part'} eq $target->{'part'}) {
                    294:                 last;
                    295:             }
                    296:         } elsif ($granularity eq 'response') {
                    297:             if ($curr_item->{'symb'} eq $target->{'symb'} &&
                    298:                 $curr_item->{'part'} eq $target->{'part'} &&
                    299:                 $curr_item->{'respid'} eq $target->{'respid'} &&
                    300:                 $curr_item->{'resptype'} eq $target->{'resptype'}) {
                    301:                 last;
                    302:             }
                    303:         }
                    304:     }
                    305:     my $curr_item = $Resource[$curr_idx];
                    306:     if ($granularity eq 'part') {
                    307:         if ($curr_item->{'symb'}     ne $target->{'symb'} ||
                    308:             $curr_item->{'part'}     ne $target->{'part'}) {
                    309:             # bogus symb - return nothing
                    310:             return (undef,undef,undef);
                    311:         }
                    312:     } elsif ($granularity eq 'response') {
                    313:         if ($curr_item->{'symb'}     ne $target->{'symb'} ||
                    314:             $curr_item->{'part'}     ne $target->{'part'} ||
                    315:             $curr_item->{'respid'}   ne $target->{'respid'} ||
                    316:             $curr_item->{'resptype'} ne $target->{'resptype'}){
                    317:             # bogus symb - return nothing
                    318:             return (undef,undef,undef);
                    319:         }
                    320:     }
                    321:     #
                    322:     # Now just pick up the data we need
                    323:     my ($prev,$curr,$next);
                    324:     if ($curr_idx == 0) {
                    325:         $prev = undef;
                    326:         $curr = $Resource[$curr_idx  ];
                    327:         $next = $Resource[$curr_idx+1];
                    328:     } elsif ($curr_idx == $#Resource) {
                    329:         $prev = $Resource[$curr_idx-1];
                    330:         $curr = $Resource[$curr_idx  ];
                    331:         $next = undef;
                    332:     } else {
                    333:         $prev = $Resource[$curr_idx-1];
                    334:         $curr = $Resource[$curr_idx  ];
                    335:         $next = $Resource[$curr_idx+1];
                    336:     }
                    337:     return ($prev,$curr,$next);
                    338: }
                    339: 
                    340: ####################################################
                    341: ####################################################
                    342: 
                    343: =pod
                    344: 
                    345: =back
                    346: 
                    347: =cut
                    348: 
                    349: ####################################################
                    350: ####################################################
1.1       matthew   351: 
                    352: 1;
                    353: 
                    354: __END__

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