Return to lonstathelpers.pm CVS log

Up to [LON-CAPA] / loncom / interface / statistics

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.

# The LearningOnline Network with CAPA
#
# $Id: lonstathelpers.pm,v 1.2 2004/01/20 15:51:06 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
####################################################
####################################################

=pod

=head1 NAME

Apache::lonstathelpers - helper routines used by statistics

=head1 SYNOPSIS

This module provides a place to consolidate much of the statistics 
routines that are needed across multiple statistics functions.

=head1 OVERVIEW


=over 4

=cut

####################################################
####################################################
package Apache::lonstathelpers;

use strict;
use Apache::lonnet();
use Apache::loncommon();
use Apache::lonhtmlcommon();
use Apache::loncoursedata();
use Apache::lonstatistics;
use Apache::lonlocal;
use HTML::Entities();
use Time::Local();
use Spreadsheet::WriteExcel();

####################################################
####################################################

=pod

=item &render_resource($resource)

Input: a resource generated from 
&Apache::loncoursedata::get_sequence_assessment_data().

Retunrs: a scalar containing html for a rendering of the problem
within a table.

=cut

####################################################
####################################################
sub render_resource {
    my ($resource) = @_;
    ##
    ## Render the problem
    my $base;
    ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
    $base = "http://".$ENV{'SERVER_NAME'}.$base;
    my $rendered_problem = 
        &Apache::lonnet::ssi_body($resource->{'src'});
    $rendered_problem =~ s/<\s*form\s*/<nop /g;
    $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;
    return '<table bgcolor="ffffff"><tr><td>'.
        '<base href="'.$base.'" />'.
        $rendered_problem.
        '</td></tr></table>';
}

####################################################
####################################################

=pod

=item &ProblemSelector($AcceptedResponseTypes)

Input: scalar containing regular expression which matches response
types to show.  '.' will yield all, '(option|radiobutton)' will match
all option response and radiobutton problems.

Returns: A string containing html for a table which lists the sequences
and their contents.  A radiobutton is provided for each problem.

=cut

####################################################
####################################################
sub ProblemSelector {
    my ($AcceptedResponseTypes) = @_;
    my $Str;
    $Str = "\n<table>\n";
    foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
        next if ($seq->{'num_assess'}<1);
        my $seq_str = '';
        foreach my $res (@{$seq->{'contents'}}) {
            next if ($res->{'type'} ne 'assessment');
            foreach my $part (@{$res->{'parts'}}) {
                my $partdata = $res->{'partdata'}->{$part};
                if ((! exists($partdata->{'option'}) || 
                     $partdata->{'option'} == 0      ) &&
                    (! exists($partdata->{'radiobutton'}) ||
                     $partdata->{'radiobutton'} == 0)) {
                    next;
                }
                for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
                    my $respid = $partdata->{'ResponseIds'}->[$i];
                    my $resptype = $partdata->{'ResponseTypes'}->[$i];
                    if ($resptype =~ m/$AcceptedResponseTypes/) {
                        my $value = &make_target_id({symb=>$res->{'symb'},
                                                     part=>$part,
                                                     respid=>$respid,
                                                     resptype=>$resptype});
                        my $checked = '';
                        if ($ENV{'form.problemchoice'} eq $value) {
                            $checked = 'checked ';
                        }
                        my $title = $res->{'title'};
                        if (! defined($title) || $title eq '') {
                            ($title) = ($res->{'src'} =~ m:/([^/]*)$:);
                        }
                        $seq_str .= '<tr><td>'.
  '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
  '</td><td>'.          
  $resptype.'</td><td>'.
  '<a href="'.$res->{'src'}.'">'.$title.'</a> ';
#  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';
                        if ($partdata->{'option'} > 1) {
                            $seq_str .= &mt('response').' '.$respid;
                        }
                        $seq_str .= "</td></tr>\n";
                    }
                }
            }
        }
        if ($seq_str ne '') {
            $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'.
                "</tr>\n".$seq_str;
        }
    }
    $Str .= "</table>\n";
    return $Str;
}

####################################################
####################################################

=pod

=item &make_target_id($target)

Inputs: Hash ref with the following entries:
    $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
    $target->{'resptype'}.

Returns: A string, suitable for a form parameter, which uniquely identifies
the problem, part, and response to do statistical analysis on.

Used by Apache::lonstathelpers::ProblemSelector().

=cut

####################################################
####################################################
sub make_target_id {
    my ($target) = @_;
    my $id = &Apache::lonnet::escape($target->{'symb'}).':'.
             &Apache::lonnet::escape($target->{'part'}).':'.
             &Apache::lonnet::escape($target->{'respid'}).':'.
             &Apache::lonnet::escape($target->{'resptype'});
    return $id;
}

####################################################
####################################################

=pod

=item &get_target_from_id($id)

Inputs: $id, a scalar string from Apache::lonstathelpers::make_target_id().

Returns: A hash reference, $target, containing the following keys:
    $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
    $target->{'resptype'}.

=cut

####################################################
####################################################
sub get_target_from_id {
    my ($id) = @_;
    my ($symb,$part,$respid,$resptype) = split(':',$id);
    return ({ symb    =>&Apache::lonnet::unescape($symb),
             part     =>&Apache::lonnet::unescape($part),
             respid   =>&Apache::lonnet::unescape($respid),
             resptype =>&Apache::lonnet::unescape($resptype)});
}

####################################################
####################################################

=pod

=item &get_prev_curr_next($target)

Determine the problem parts or responses preceeding and following the
current resource.

Inputs: $target (see &Apache::lonstathelpers::get_target_from_id())
  $AcceptableResponseTypes, regular expression matching acceptable
                            response types,
  $granularity, either 'part' or 'response'

Returns: three hash references, $prev, $curr, $next, which refer to the
preceeding, current, or following problem parts or responses, depending
on the value of $granularity.  Values of undef indicate there is no
previous or next part/response.  A value of undef for all three indicates
there was no match found to the current part/resource.

The hash references contain the following keys:
    symb, part, resource

If $granularity eq 'response', the following ADDITIONAL keys will be present:
    respid, resptype

=cut

####################################################
####################################################
sub get_prev_curr_next {
    my ($target,$AcceptableResponseTypes,$granularity) = @_;
    #
    # Build an array with the data we need to search through
    my @Resource;
    foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
        foreach my $res (@{$seq->{'contents'}}) {
            next if ($res->{'type'} ne 'assessment');
            foreach my $part (@{$res->{'parts'}}) {
                my $partdata = $res->{'partdata'}->{$part};
                if ($granularity eq 'part') {
                    push (@Resource,
                          { symb     => $res->{symb},
                            part     => $part,
                            resource => $res,
                        } );
                } elsif ($granularity eq 'response') {
                    for (my $i=0;
                         $i<scalar(@{$partdata->{'ResponseTypes'}});
                         $i++){
                        my $respid = $partdata->{'ResponseIds'}->[$i];
                        my $resptype = $partdata->{'ResponseTypes'}->[$i];
                        next if ($resptype !~ m/$AcceptableResponseTypes/);
                        push (@Resource,
                              { symb     => $res->{symb},
                                part     => $part,
                                respid   => $partdata->{'ResponseIds'}->[$i],
                                resource => $res,
                                resptype => $resptype
                                } );
                    }
                }
            }
        }
    }
    #
    # Get the index of the current situation
    my $curr_idx;
    for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {
        my $curr_item = $Resource[$curr_idx];
        if ($granularity eq 'part') {
            if ($curr_item->{'symb'} eq $target->{'symb'} &&
                $curr_item->{'part'} eq $target->{'part'}) {
                last;
            }
        } elsif ($granularity eq 'response') {
            if ($curr_item->{'symb'} eq $target->{'symb'} &&
                $curr_item->{'part'} eq $target->{'part'} &&
                $curr_item->{'respid'} eq $target->{'respid'} &&
                $curr_item->{'resptype'} eq $target->{'resptype'}) {
                last;
            }
        }
    }
    my $curr_item = $Resource[$curr_idx];
    if ($granularity eq 'part') {
        if ($curr_item->{'symb'}     ne $target->{'symb'} ||
            $curr_item->{'part'}     ne $target->{'part'}) {
            # bogus symb - return nothing
            return (undef,undef,undef);
        }
    } elsif ($granularity eq 'response') {
        if ($curr_item->{'symb'}     ne $target->{'symb'} ||
            $curr_item->{'part'}     ne $target->{'part'} ||
            $curr_item->{'respid'}   ne $target->{'respid'} ||
            $curr_item->{'resptype'} ne $target->{'resptype'}){
            # bogus symb - return nothing
            return (undef,undef,undef);
        }
    }
    #
    # Now just pick up the data we need
    my ($prev,$curr,$next);
    if ($curr_idx == 0) {
        $prev = undef;
        $curr = $Resource[$curr_idx  ];
        $next = $Resource[$curr_idx+1];
    } elsif ($curr_idx == $#Resource) {
        $prev = $Resource[$curr_idx-1];
        $curr = $Resource[$curr_idx  ];
        $next = undef;
    } else {
        $prev = $Resource[$curr_idx-1];
        $curr = $Resource[$curr_idx  ];
        $next = $Resource[$curr_idx+1];
    }
    return ($prev,$curr,$next);
}

####################################################
####################################################

=pod

=back

=cut

####################################################
####################################################

1;

__END__