File:  [LON-CAPA] / loncom / interface / statistics / lonstathelpers.pm
Revision 1.3: download - view: text, annotated - select for diffs
Fri Feb 13 18:34:40 2004 UTC (20 years, 4 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
&ProblemSelector: Remove redundant check on problem type.

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonstathelpers.pm,v 1.3 2004/02/13 18:34:40 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:                 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: ####################################################
  351: 
  352: 1;
  353: 
  354: __END__

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