File:  [LON-CAPA] / loncom / interface / statistics / lonstathelpers.pm
Revision 1.2: download - view: text, annotated - select for diffs
Tue Jan 20 15:51:06 2004 UTC (20 years, 5 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Moved &ProblemSelector from lonproblemanalysis and lonsubmissiontimeanalysis
to lonstathelpers.pm.  Reworked &ProblemSelector to work with either problem
parts or responses.  Added previous and next buttons to submission time
analysis page.

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonstathelpers.pm,v 1.2 2004/01/20 15:51:06 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: ####################################################
   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: }
   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:                 if ((! exists($partdata->{'option'}) || 
  127:                      $partdata->{'option'} == 0      ) &&
  128:                     (! exists($partdata->{'radiobutton'}) ||
  129:                      $partdata->{'radiobutton'} == 0)) {
  130:                     next;
  131:                 }
  132:                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
  133:                     my $respid = $partdata->{'ResponseIds'}->[$i];
  134:                     my $resptype = $partdata->{'ResponseTypes'}->[$i];
  135:                     if ($resptype =~ m/$AcceptedResponseTypes/) {
  136:                         my $value = &make_target_id({symb=>$res->{'symb'},
  137:                                                      part=>$part,
  138:                                                      respid=>$respid,
  139:                                                      resptype=>$resptype});
  140:                         my $checked = '';
  141:                         if ($ENV{'form.problemchoice'} eq $value) {
  142:                             $checked = 'checked ';
  143:                         }
  144:                         my $title = $res->{'title'};
  145:                         if (! defined($title) || $title eq '') {
  146:                             ($title) = ($res->{'src'} =~ m:/([^/]*)$:);
  147:                         }
  148:                         $seq_str .= '<tr><td>'.
  149:   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
  150:   '</td><td>'.          
  151:   $resptype.'</td><td>'.
  152:   '<a href="'.$res->{'src'}.'">'.$title.'</a> ';
  153: #  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';
  154:                         if ($partdata->{'option'} > 1) {
  155:                             $seq_str .= &mt('response').' '.$respid;
  156:                         }
  157:                         $seq_str .= "</td></tr>\n";
  158:                     }
  159:                 }
  160:             }
  161:         }
  162:         if ($seq_str ne '') {
  163:             $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'.
  164:                 "</tr>\n".$seq_str;
  165:         }
  166:     }
  167:     $Str .= "</table>\n";
  168:     return $Str;
  169: }
  170: 
  171: ####################################################
  172: ####################################################
  173: 
  174: =pod
  175: 
  176: =item &make_target_id($target)
  177: 
  178: Inputs: Hash ref with the following entries:
  179:     $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
  180:     $target->{'resptype'}.
  181: 
  182: Returns: A string, suitable for a form parameter, which uniquely identifies
  183: the problem, part, and response to do statistical analysis on.
  184: 
  185: Used by Apache::lonstathelpers::ProblemSelector().
  186: 
  187: =cut
  188: 
  189: ####################################################
  190: ####################################################
  191: sub make_target_id {
  192:     my ($target) = @_;
  193:     my $id = &Apache::lonnet::escape($target->{'symb'}).':'.
  194:              &Apache::lonnet::escape($target->{'part'}).':'.
  195:              &Apache::lonnet::escape($target->{'respid'}).':'.
  196:              &Apache::lonnet::escape($target->{'resptype'});
  197:     return $id;
  198: }
  199: 
  200: ####################################################
  201: ####################################################
  202: 
  203: =pod
  204: 
  205: =item &get_target_from_id($id)
  206: 
  207: Inputs: $id, a scalar string from Apache::lonstathelpers::make_target_id().
  208: 
  209: Returns: A hash reference, $target, containing the following keys:
  210:     $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
  211:     $target->{'resptype'}.
  212: 
  213: =cut
  214: 
  215: ####################################################
  216: ####################################################
  217: sub get_target_from_id {
  218:     my ($id) = @_;
  219:     my ($symb,$part,$respid,$resptype) = split(':',$id);
  220:     return ({ symb    =>&Apache::lonnet::unescape($symb),
  221:              part     =>&Apache::lonnet::unescape($part),
  222:              respid   =>&Apache::lonnet::unescape($respid),
  223:              resptype =>&Apache::lonnet::unescape($resptype)});
  224: }
  225: 
  226: ####################################################
  227: ####################################################
  228: 
  229: =pod
  230: 
  231: =item &get_prev_curr_next($target)
  232: 
  233: Determine the problem parts or responses preceeding and following the
  234: current resource.
  235: 
  236: Inputs: $target (see &Apache::lonstathelpers::get_target_from_id())
  237:   $AcceptableResponseTypes, regular expression matching acceptable
  238:                             response types,
  239:   $granularity, either 'part' or 'response'
  240: 
  241: Returns: three hash references, $prev, $curr, $next, which refer to the
  242: preceeding, current, or following problem parts or responses, depending
  243: on the value of $granularity.  Values of undef indicate there is no
  244: previous or next part/response.  A value of undef for all three indicates
  245: there was no match found to the current part/resource.
  246: 
  247: The hash references contain the following keys:
  248:     symb, part, resource
  249: 
  250: If $granularity eq 'response', the following ADDITIONAL keys will be present:
  251:     respid, resptype
  252: 
  253: =cut
  254: 
  255: ####################################################
  256: ####################################################
  257: sub get_prev_curr_next {
  258:     my ($target,$AcceptableResponseTypes,$granularity) = @_;
  259:     #
  260:     # Build an array with the data we need to search through
  261:     my @Resource;
  262:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
  263:         foreach my $res (@{$seq->{'contents'}}) {
  264:             next if ($res->{'type'} ne 'assessment');
  265:             foreach my $part (@{$res->{'parts'}}) {
  266:                 my $partdata = $res->{'partdata'}->{$part};
  267:                 if ($granularity eq 'part') {
  268:                     push (@Resource,
  269:                           { symb     => $res->{symb},
  270:                             part     => $part,
  271:                             resource => $res,
  272:                         } );
  273:                 } elsif ($granularity eq 'response') {
  274:                     for (my $i=0;
  275:                          $i<scalar(@{$partdata->{'ResponseTypes'}});
  276:                          $i++){
  277:                         my $respid = $partdata->{'ResponseIds'}->[$i];
  278:                         my $resptype = $partdata->{'ResponseTypes'}->[$i];
  279:                         next if ($resptype !~ m/$AcceptableResponseTypes/);
  280:                         push (@Resource,
  281:                               { symb     => $res->{symb},
  282:                                 part     => $part,
  283:                                 respid   => $partdata->{'ResponseIds'}->[$i],
  284:                                 resource => $res,
  285:                                 resptype => $resptype
  286:                                 } );
  287:                     }
  288:                 }
  289:             }
  290:         }
  291:     }
  292:     #
  293:     # Get the index of the current situation
  294:     my $curr_idx;
  295:     for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {
  296:         my $curr_item = $Resource[$curr_idx];
  297:         if ($granularity eq 'part') {
  298:             if ($curr_item->{'symb'} eq $target->{'symb'} &&
  299:                 $curr_item->{'part'} eq $target->{'part'}) {
  300:                 last;
  301:             }
  302:         } elsif ($granularity eq 'response') {
  303:             if ($curr_item->{'symb'} eq $target->{'symb'} &&
  304:                 $curr_item->{'part'} eq $target->{'part'} &&
  305:                 $curr_item->{'respid'} eq $target->{'respid'} &&
  306:                 $curr_item->{'resptype'} eq $target->{'resptype'}) {
  307:                 last;
  308:             }
  309:         }
  310:     }
  311:     my $curr_item = $Resource[$curr_idx];
  312:     if ($granularity eq 'part') {
  313:         if ($curr_item->{'symb'}     ne $target->{'symb'} ||
  314:             $curr_item->{'part'}     ne $target->{'part'}) {
  315:             # bogus symb - return nothing
  316:             return (undef,undef,undef);
  317:         }
  318:     } elsif ($granularity eq 'response') {
  319:         if ($curr_item->{'symb'}     ne $target->{'symb'} ||
  320:             $curr_item->{'part'}     ne $target->{'part'} ||
  321:             $curr_item->{'respid'}   ne $target->{'respid'} ||
  322:             $curr_item->{'resptype'} ne $target->{'resptype'}){
  323:             # bogus symb - return nothing
  324:             return (undef,undef,undef);
  325:         }
  326:     }
  327:     #
  328:     # Now just pick up the data we need
  329:     my ($prev,$curr,$next);
  330:     if ($curr_idx == 0) {
  331:         $prev = undef;
  332:         $curr = $Resource[$curr_idx  ];
  333:         $next = $Resource[$curr_idx+1];
  334:     } elsif ($curr_idx == $#Resource) {
  335:         $prev = $Resource[$curr_idx-1];
  336:         $curr = $Resource[$curr_idx  ];
  337:         $next = undef;
  338:     } else {
  339:         $prev = $Resource[$curr_idx-1];
  340:         $curr = $Resource[$curr_idx  ];
  341:         $next = $Resource[$curr_idx+1];
  342:     }
  343:     return ($prev,$curr,$next);
  344: }
  345: 
  346: ####################################################
  347: ####################################################
  348: 
  349: =pod
  350: 
  351: =back
  352: 
  353: =cut
  354: 
  355: ####################################################
  356: ####################################################
  357: 
  358: 1;
  359: 
  360: __END__

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