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

1.1       matthew     1: # The LearningOnline Network with CAPA
                      2: #
1.2     ! matthew     3: # $Id: lonstathelpers.pm,v 1.1 2004/01/19 21:29:46 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:                 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: ####################################################
1.1       matthew   357: 
                    358: 1;
                    359: 
                    360: __END__

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