loncom/interface/statistics/lonstathelpers.pm - view

File: [LON-CAPA] / loncom / interface / statistics / lonstathelpers.pm
Revision 1.5: download - view: text, annotated - select for diffs
Wed Mar 3 22:57:31 2004 UTC (21 years, 2 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Modified &ProblemSelector to output response information for all response
types, not just option response.
Added &limit_by_time_form, &limit_by_time, and &get_time_limits which will
be used to indicate when a report should be restricted by the time of
submission.  Not fully tested.

# The LearningOnline Network with CAPA # # $Id: lonstathelpers.pm,v 1.5 2004/03/03 22:57:31 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}; 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 (scalar(@{$partdata->{'ResponseIds'}}) > 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 =item analyze_problem_as_student Analyzes a homework problem for a student and returns the correct answer for the student. Attempts to put together an answer for problem types that do not natively support it. Inputs: $resource: a resource object $sname, $sdom, $partid, $respid Returns: $answer =cut ##################################################### ##################################################### sub analyze_problem_as_student { my ($resource,$sname,$sdom,$partid,$respid) = @_; my $returnvalue; my $url = $resource->{'src'}; my $symb = $resource->{'symb'}; my $courseid = $ENV{'request.course.id'}; my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze', 'grade_domain' => $sdom, 'grade_username' => $sname, 'grade_symb' => $symb, 'grade_courseid' => $courseid)); (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2); my %Answer=&Apache::lonnet::str2hash($Answ); my $prefix = $partid.'.'.$respid; my $key = $prefix.'.answer'; if (exists($Answer{$key})) { my $student_answer = $Answer{$key}->[0]; if (! defined($student_answer)) { $student_answer = $Answer{$key}->[1]; } $returnvalue = $student_answer; } else { if (exists($Answer{$prefix.'.shown'})) { # The response has foils my %values; while (my ($k,$v) = each(%Answer)) { next if ($k !~ /^$prefix\.foil\.(value|area)\.(.*)$/); my $foilname = $2; $values{$foilname}=$v; } foreach my $foil (@{$Answer{$prefix.'.shown'}}) { if (ref($values{$foil}) eq 'ARRAY') { $returnvalue.=&HTML::Entities::encode($foil).'='. join(',',map {&HTML::Entities::encode($_)} @{$values{$foil}}).'&'; } else { $returnvalue.=&HTML::Entities::encode($foil).'='. &HTML::Entities::encode($values{$foil}).'&'; } } $returnvalue =~ s/ /\%20/g; chop ($returnvalue); } } return $returnvalue; } ## ## The following is copied from datecalc1.pl, part of the ## Spreadsheet::WriteExcel CPAN module. ## ## ###################################################################### # # Demonstration of writing date/time cells to Excel spreadsheets, # using UNIX/Perl time as source of date/time. # # Copyright 2000, Andrew Benham, adsb@bigfoot.com # ###################################################################### # # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970) # measured in seconds. # # An Excel file can use exactly one of two different date/time systems. # In these systems, a floating point number represents the number of days # (and fractional parts of the day) since a start point. The floating point # number is referred to as a 'serial'. # The two systems ('1900' and '1904') use different starting points: # '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as # a leap year - see: # http://support.microsoft.com/support/kb/articles/Q181/3/70.asp # for the excuse^H^H^H^H^H^Hreason. # '1904'; '1.00' is 2 Jan 1904. # # The '1904' system is the default for Apple Macs. Windows versions of # Excel have the option to use the '1904' system. # # Note that Visual Basic's "DateSerial" function does NOT erroneously # regard 1900 as a leap year, and thus its serials do not agree with # the 1900 serials of Excel for dates before 1 Mar 1900. # # Note that StarOffice (at least at version 5.2) does NOT erroneously # regard 1900 as a leap year, and thus its serials do not agree with # the 1900 serials of Excel for dates before 1 Mar 1900. # ###################################################################### # # Calculation description # ======================= # # 1900 system # ----------- # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900. # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68) # were leap years with an extra day. # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and # 1 Jan 1970. # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'. # # 1904 system # ----------- # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904. # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68) # were leap years with an extra day. # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and # 1 Jan 1970. # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'. # ###################################################################### # # Copyright (c) 2000, Andrew Benham. # This program is free software. It may be used, redistributed and/or # modified under the same terms as Perl itself. # # Andrew Benham, adsb@bigfoot.com # London, United Kingdom # 11 Nov 2000 # ###################################################################### #----------------------------------------------------------- # calc_serial() # # Called with (up to) 2 parameters. # 1. Unix timestamp. If omitted, uses current time. # 2. GMT flag. Set to '1' to return serial in GMT. # If omitted, returns serial in appropriate timezone. # # Returns date/time serial according to $DATE_SYSTEM selected #----------------------------------------------------------- sub calc_serial { # Use 1900 date system on all platforms other than Apple Mac (for which # use 1904 date system). my $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0; my $time = (defined $_[0]) ? $_[0] : time(); my $gmtflag = (defined $_[1]) ? $_[1] : 0; # # Divide timestamp by number of seconds in a day. # This gives a date serial with '0' on 1 Jan 1970. my $serial = $time / 86400; # # Adjust the date serial by the offset appropriate to the # currently selected system (1900/1904). if ($DATE_SYSTEM == 0) { # use 1900 system $serial += 25569; } else { # use 1904 system $serial += 24107; } # unless ($gmtflag) { # Now have a 'raw' serial with the right offset. But this # gives a serial in GMT, which is false unless the timezone # is GMT. We need to adjust the serial by the appropriate # timezone offset. # Calculate the appropriate timezone offset by seeing what # the differences between localtime and gmtime for the given # time are. # my @gmtime = gmtime($time); my @ltime = localtime($time); # # For the first 7 elements of the two arrays, adjust the # date serial where the elements differ. for (0 .. 6) { my $diff = $ltime[$_] - $gmtime[$_]; if ($diff) { $serial += _adjustment($diff,$_); } } } # # Perpetuate the error that 1900 was a leap year by decrementing # the serial if we're using the 1900 system and the date is prior to # 1 Mar 1900. This has the effect of making serial value '60' # 29 Feb 1900. # # This fix only has any effect if UNIX/Perl time on the platform # can represent 1900. Many can't. # unless ($DATE_SYSTEM) { $serial-- if ($serial < 61); # '61' is 1 Mar 1900 } return $serial; } sub _adjustment { # Based on the difference in the localtime/gmtime array elements # number, return the adjustment required to the serial. # # We only look at some elements of the localtime/gmtime arrays: # seconds unlikely to be different as all known timezones # have an offset of integral multiples of 15 minutes, # but it's easy to do. # minutes will be different for timezone offsets which are # not an exact number of hours. # hours very likely to be different. # weekday will differ when localtime/gmtime difference # straddles midnight. # # Assume that difference between localtime and gmtime is less than # 5 days, then don't have to do maths for day of month, month number, # year number, etc... # my ($delta,$element) = @_; my $adjust = 0; # if ($element == 0) { # Seconds $adjust = $delta/86400; # 60 * 60 * 24 } elsif ($element == 1) { # Minutes $adjust = $delta/1440; # 60 * 24 } elsif ($element == 2) { # Hours $adjust = $delta/24; # 24 } elsif ($element == 6) { # Day of week number # Catch difference straddling Sat/Sun in either direction $delta += 7 if ($delta < -4); $delta -= 7 if ($delta > 4); # $adjust = $delta; } return $adjust; } ########################################################### ########################################################### =pod =item get_problem_data Returns a data structure describing the problem. Inputs: $url Returns: %Partdata =cut ## note: we must force each foil and option to not begin or end with ## spaces as they are stored without such data. ## ########################################################### ########################################################### sub get_problem_data { my ($url) = @_; my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze')); (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2); my %Answer; %Answer=&Apache::lonnet::str2hash($Answ); my %Partdata; foreach my $part (@{$Answer{'parts'}}) { while (my($key,$value) = each(%Answer)) { # # Logging code: if (1) { &Apache::lonnet::logthis($part.' got key "'.$key.'"'); if (ref($value) eq 'ARRAY') { &Apache::lonnet::logthis(' @'.join(',',@$value)); } else { &Apache::lonnet::logthis(' '.$value); } } # End of logging code next if ($key !~ /^$part/); $key =~ s/^$part\.//; if (ref($value) eq 'ARRAY') { if ($key eq 'options') { $Partdata{$part}->{'_Options'}=$value; } elsif ($key eq 'concepts') { $Partdata{$part}->{'_Concepts'}=$value; } elsif ($key =~ /^concept\.(.*)$/) { my $concept = $1; foreach my $foil (@$value) { $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}= $concept; } } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high)$/) { $Partdata{$part}->{$key}=$value; } } else { if ($key=~ /^foil\.text\.(.*)$/) { my $foil = $1; $Partdata{$part}->{'_Foils'}->{$foil}->{'name'}=$foil; $value =~ s/(\s*$|^\s*)//g; $Partdata{$part}->{'_Foils'}->{$foil}->{'text'}=$value; } elsif ($key =~ /^foil\.value\.(.*)$/) { my $foil = $1; $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value; } } } } return %Partdata; } #################################################### #################################################### =pod =item &limit_by_time() =cut #################################################### #################################################### sub limit_by_time_form { my $Starttime_form = ''; my $starttime = &Apache::lonhtmlcommon::get_date_from_form ('limitby_startdate'); my $endtime = &Apache::lonhtmlcommon::get_date_from_form ('limitby_enddate'); if (! defined($endtime)) { $endtime = time; } if (! defined($starttime)) { $starttime = $endtime - 60*60*24*7; } my $state; if (&limit_by_time()) { $state = ''; } else { $state = 'disabled'; } my $startdateform = &Apache::lonhtmlcommon::date_setter ('Statistics','limitby_startdate',$starttime,undef,undef,$state); my $enddateform = &Apache::lonhtmlcommon::date_setter ('Statistics','limitby_enddate',$endtime,undef,undef,$state); my $Str; $Str .= '<script language="Javascript" >'; $Str .= 'function toggle_limitby_activity(state) {'; $Str .= ' if (state) {'; $Str .= ' limitby_startdate_enable();'; $Str .= ' limitby_enddate_enable();'; $Str .= ' } else {'; $Str .= ' limitby_startdate_disable();'; $Str .= ' limitby_enddate_disable();'; $Str .= ' }'; $Str .= '}'; $Str .= '</script>'; $Str .= '<fieldset>'; my $timecheckbox = '<input type="checkbox" name="limit_by_time" '; if (&limit_by_time()) { $timecheckbox .= ' checked '; } $timecheckbox .= 'OnChange="javascript:toggle_limitby_activity(this.checked);" '; $timecheckbox .= ' />'; $Str .= '<legend>'.&mt('[_1] Limit by time',$timecheckbox).'</legend>'; $Str .= &mt('Start Time: [_1]',$startdateform).'<br />'; $Str .= &mt(' End Time: [_1]',$enddateform).'<br />'; $Str .= '</fieldset>'; return $Str; } sub limit_by_time { if (exists($ENV{'form.limit_by_time'}) && $ENV{'form.limit_by_time'} ne '' ) { return 1; } else { return 0; } } sub get_time_limits { my $starttime = &Apache::lonhtmlcommon::get_date_from_form ('limitby_startdate'); my $endtime = &Apache::lonhtmlcommon::get_date_from_form ('limitby_enddate'); return ($starttime,$endtime); } #################################################### #################################################### =pod =back =cut #################################################### #################################################### 1; __END__