# The LearningOnline Network with CAPA
#
# $Id: lonsurveyreports.pm,v 1.16 2008/09/14 15:16:30 raeburn 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/
#
package Apache::lonsurveyreports;
use strict;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonhtmlcommon();
use Apache::loncoursedata();
use Apache::lonstatistics;
use Apache::lonlocal;
use Apache::lonstathelpers;
use Spreadsheet::WriteExcel;
use HTML::Entities();
use Time::Local();
use lib '/home/httpd/lib/perl/';
use LONCAPA;
my @SubmitButtons = (
{ name => 'break'},
{ name => 'PrevProblem',
text => 'Previous Survey' },
{ name => 'NextProblem',
text => 'Next Survey' },
{ name => 'SelectAnother',
text => 'Choose a different Survey' },
{ name => 'break'},
{ name => 'Generate',
text => 'Generate Report'},
);
sub BuildSurveyReportsPage {
my ($r,$c)=@_;
#
my %Saveable_Parameters = ('Status' => 'scalar',
'Section' => 'array',
'NumPlots' => 'scalar',
);
&Apache::loncommon::store_course_settings('survey_reports',
\%Saveable_Parameters);
&Apache::loncommon::restore_course_settings('survey_resports',
\%Saveable_Parameters);
#
&Apache::lonstatistics::PrepareClasslist();
#
$r->print(&CreateInterface());
#
my @Students = @Apache::lonstatistics::Students;
#
if (@Students < 1) {
$r->print('<h2>There are no students in the sections selected</h2>');
}
#
my @CacheButtonHTML =
&Apache::lonstathelpers::manage_caches($r,'Statistics','stats_status');
$r->rflush();
#
if (exists($env{'form.problemchoice'}) &&
! exists($env{'form.SelectAnother'})) {
$r->print(' 'x3);
foreach my $button (@SubmitButtons) {
if ($button->{'name'} eq 'break') {
$r->print("<br />\n");
} else {
$r->print('<input type="submit" name="'.$button->{'name'}.'" '.
'value="'.&mt($button->{'text'}).'" />');
$r->print(' 'x5);
}
}
foreach my $html (@CacheButtonHTML) {
$r->print($html.(' 'x5));
}
#
$r->print('<hr />');
$r->print('<h4>'.
&Apache::lonlocal::locallocaltime(time).','.
&Apache::lonstatistics::section_and_enrollment_description().
'</h4>');
$r->rflush();
#
# Determine which problem we are to analyze
my $current_problem = &Apache::lonstathelpers::get_target_from_id
($env{'form.problemchoice'});
#
my ($navmap,$prev,$curr,$next) =
&Apache::lonstathelpers::get_prev_curr_next($current_problem,
'.',
'part_survey',
);
if (exists($env{'form.PrevProblem'}) && defined($prev)) {
$current_problem = $prev;
} elsif (exists($env{'form.NextProblem'}) && defined($next)) {
$current_problem = $next;
} else {
$current_problem = $curr;
}
#
# Store the current problem choice and send it out in the form
$env{'form.problemchoice'} =
&Apache::lonstathelpers::make_target_id($current_problem);
$r->print('<input type="hidden" name="problemchoice" value="'.
$env{'form.problemchoice'}.'" />');
#
if (! defined($current_problem->{'resource'})) {
$r->print('resource is undefined');
} else {
my $resource = $current_problem->{'resource'};
$r->print('<h1>'.$resource->compTitle.'</h1>');
$r->print('<h3>'.$resource->src.'</h3>');
if ($env{'form.renderprob'} eq 'true') {
$r->print(&Apache::lonstathelpers::render_resource($resource));
}
$r->rflush();
my %Data = &Apache::lonstathelpers::get_problem_data
($resource->src);
&compile_student_answers($r,$current_problem,\%Data,\@Students);
if ($env{'form.output'} eq 'HTML' ||
! defined($env{'form.output'})) {
&make_HTML_report($r,$current_problem,\%Data,\@Students);
} elsif ($env{'form.output'} eq 'Excel') {
&make_Excel_report($r,$current_problem,\%Data,\@Students);
} elsif ($env{'form.output'} eq 'TXT') {
&make_text_report($r,$current_problem,\%Data,\@Students);
}
}
$r->print('<hr />');
} else {
$r->print('<input type="submit" name="Generate" value="'.
&mt('Generate Survey Report').'" />');
$r->print(' 'x5);
$r->print('<h3>'.&mt('Please select a Survey to analyze').'</h3>');
$r->print(&SurveyProblemSelector());
}
}
##########################################################
##########################################################
##
## SurveyProblemSelector
##
##########################################################
##########################################################
sub SurveyProblemSelector {
my $Str = '';
my @SurveyProblems;
my ($navmap,@sequences) =
&Apache::lonstatistics::selected_sequences_with_assessments('all');
foreach my $seq (@sequences) {
my @resources = &Apache::lonstathelpers::get_resources($navmap,$seq);
foreach my $res (@resources) {
foreach my $part (@{$res->parts}) {
if ($res->is_survey($part)) {
push(@SurveyProblems,{res=>$res,seq=>$seq,part=>$part});
last;
}
}
}
}
if (! scalar(@SurveyProblems)) {
$Str = '<h1>'.
&mt('There are no survey problems in this course').
'</h1>'.$/;
return $Str;
}
$Str .= '<table>'.$/;
$Str .= '<tr>'.'<td></td>'.
'<th>'.&mt('Survey').'</th>'.
'</tr>'.$/;
my $id;
foreach my $problem (@SurveyProblems) {
$id++;
my $value = &Apache::lonstathelpers::make_target_id
({symb=>$problem->{'res'}->symb,
part=>$problem->{'part'},
respid=>undef,
resptype=>undef});
my $checked = '';
if ($env{'form.problemchoice'} eq $value) {
$checked = 'checked ';
}
my $link = $problem->{'res'}->link.
'?symb='.&escape($problem->{'res'}->shown_symb);
$Str .= '<tr><td>'.
'<input type="radio" name="problemchoice" id="'.$id.'" '.
'value="'.$value.'" '.$checked.'/>'.'</td>'.
'<td><nobr>'.
'<label for="'.$id.'">'.$problem->{'res'}->compTitle.'('.$problem->{'seq'}->compTitle.')'.'</label>'.
(' 'x2).
qq{<a target="preview" href="$link">view</a>}.'</td></tr>'.$/;
}
$Str .= '</table>';
return $Str;
}
#########################################################
#########################################################
##
## Compile Student Answers
##
#########################################################
#########################################################
sub compile_student_answers {
my ($r,$problem,$ProblemData,$Students) = @_;
my $resource = $problem->{'resource'};
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
($r,'Processing Student Submissions',
'Processing Student Submissions',
scalar(@$Students),'inline',undef,'Statistics','stats_status');
foreach my $student (@$Students) {
foreach my $partid (@{$resource->parts}) {
my @response_ids = $resource->responseIds($partid);
my @response_types = $resource->responseType($partid);
for (my $i=0;$i<=$#response_ids;$i++) {
my $respid = $response_ids[$i];
my $resptype = $response_types[$i];
my $results =
&Apache::loncoursedata::get_response_data_by_student
($student,$resource->symb,$respid);
next if (! defined($results) || ref($results) ne 'ARRAY' ||
ref($results->[0]) ne 'ARRAY');
my $student_response =
$results->[0]->[&Apache::loncoursedata::RDs_submission()];
$problem->{'responsedata'}->{$partid}->{$respid}->{'_count'}++;
my $data = $problem->{'responsedata'}->{$partid}->{$respid};
if ($resptype =~ /^(option|match)$/) {
my @responses = split('&',$student_response);
foreach my $response (@responses) {
my ($foilid,$option) =
map {
&unescape($_);
} split('=',$response);
$data->{'foil_count'}->{$foilid}++;
$data->{'foil_responses'}->{$foilid}->{$option}++;
}
} elsif ($resptype =~ /^(radiobutton)$/) {
my ($foil,$value) = map { &unescape($_); } split('=',$student_response);
$value += 1; # explicitly increment it...
$data->{'foil_responses'}->{$foil}++;
$data->{'foil_values'}->{$value}++;
if (! exists($data->{'map'}->{$value})) {
$data->{'map'}->{$value} = $foil;
$data->{'map_fv'}->{$foil} = $value;
}
} else {
# Variable stuff (essays, raw numbers, strings) go here
push(@{$data->{'responses'}},$student_response);
}
}
}
&Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
'last student');
}
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
return;
}
#########################################################
#########################################################
##
## make_text_report
##
#########################################################
#########################################################
sub make_text_report {
my ($r,$problem,$problem_data,$students) = @_;
my ($file,$filename) = &Apache::loncommon::create_text_file($r,'txt');
if (! defined($file)) { return '';}
$r->print('<script>'.
'window.document.Statistics.stats_status.value="'.
&mt('Building text document.').
'";</script>');
my $resource = $problem->{'resource'};
print $file $resource->compTitle.$/;
print $file &Apache::lonstatistics::section_and_enrollment_description().
' '.&mt('Generated on [_1]',&Apache::lonlocal::locallocaltime(time)).
$/;
my $something_has_been_output = 0;
foreach my $partid (@{$resource->parts}) {
my @response_ids = $resource->responseIds($partid);
my @response_types = $resource->responseType($partid);
for (my $i=0;$i<=$#response_ids;$i++) {
my $respid = $response_ids[$i];
my $resptype = $response_types[$i];
my $data = $problem->{'responsedata'}->{$partid}->{$respid};
if (exists($data->{'responses'}) &&
ref($data->{'responses'}) eq 'ARRAY') {
# Essay type response
print $file ('-'x40).$/;
print $file
$resource->part_display($partid).', '.$respid.':'.$resptype.$/;
foreach my $submission (@{$data->{'responses'}}) {
print $file ('-'x20).$/;
$submission =~ s/(\\r\\n|\\n)/\n/g;
$submission =~ s/\\(\'|\"|\`)/$1/g;
print $file $submission.$/.$/;
$something_has_been_output=1;
}
}
}
}
close($file);
if($something_has_been_output) {
$r->print('<p><a href="'.$filename.'">'.
&mt('Your text file.').
'</a></p>'."\n");
$r->print('<script>'.
'window.document.Statistics.stats_status.value="'.
&mt('Done compiling text file. See link below to download.').
'";</script>');
} else {
$r->print('<h2>'.
&mt("There is no essay or string response data to output for this survey.").'</h2>');
}
$r->rflush();
return;
}
#########################################################
#########################################################
##
## make_Excel_report
##
#########################################################
#########################################################
sub make_Excel_report {
my ($r,$problem,$problem_data,$students) = @_;
my ($workbook,$filename,$format) = &Apache::loncommon::create_workbook($r);
if (! defined($workbook)) { return '';}
$r->print('<script>'.
'window.document.Statistics.stats_status.value="'.
&mt('Building spreadsheet.').
'";</script>');
my $worksheet = $workbook->addworksheet('Survey Reports');
#
my $rows_output=0;
$worksheet->write($rows_output++,0,
$env{'course.'.$env{'request.course.id'}.'.description'},
$format->{'h1'});
$rows_output++;
#
my $resource = $problem->{'resource'};
$worksheet->write($rows_output++,0,$resource->compTitle,$format->{'h2'});
foreach my $partid (@{$resource->parts}) {
my @response_ids = $resource->responseIds($partid);
my @response_types = $resource->responseType($partid);
for (my $i=0;$i<=$#response_ids;$i++) {
my $respid = $response_ids[$i];
my $resptype = $response_types[$i];
my $data = $problem->{'responsedata'}->{$partid}->{$respid};
my $cols_output=0;
$worksheet->write($rows_output,$cols_output++,
$resource->part_display($partid),$format->{'h3'});
$worksheet->write($rows_output,$cols_output++,
'Response '.$respid.', '.$resptype,
$format->{'h3'});
$rows_output++;
if (exists($data->{'responses'}) &&
ref($data->{'responses'}) eq 'ARRAY') {
my $warned_about_size = 0;
foreach my $data (@{$data->{'responses'}}) {
if (length($data) > 255 && ! $warned_about_size) {
$r->print('<p>'.
&mt('[_1]:[_2] responses to [_3] may be too long to fit Excel spreadsheet.',
$resource->compTitle,
$resource->part_display($partid),
$respid).
'</p>');
$r->rflush();
$warned_about_size=1;
}
$worksheet->write($rows_output++,0,$data);
}
} elsif (exists($data->{'foil_count'}) &&
exists($data->{'foil_responses'})) {
my $respdata = $problem_data->{$partid.'.'.$respid};
my @rowdata = ('Foil Name','Foil Text','Option',
'Frequency');
$worksheet->write_row($rows_output++,0,
\@rowdata,$format->{'h4'});
#
my @foils = sort(keys(%{$respdata->{'_Foils'}}));
foreach my $foilid (@foils) {
my $foil_count = $data->{'foil_count'}->{$foilid};
my $foiltext = $respdata->{'_Foils'}->{$foilid}->{'text'};
my $foilname = $respdata->{'_Foils'}->{$foilid}->{'name'};
$foiltext = &HTML::Entities::decode($foilname);
my $cols_output=0;
$worksheet->write($rows_output,$cols_output++,$foilname);
$worksheet->write($rows_output,$cols_output++,$foiltext);
my $option_start_col = $cols_output;
#
foreach my $option (sort(@{$respdata->{'_Options'}})){
$cols_output= $option_start_col;
$worksheet->write($rows_output,$cols_output++,
$option);
my $count=
$data->{'foil_responses'}->{$foilid}->{$option};
$worksheet->write($rows_output,$cols_output++,$count);
$rows_output++;
}
}
} elsif (exists($data->{'_count'}) &&
exists($data->{'foil_values'}) &&
exists($data->{'map'})) {
my $respdata = $problem_data->{$partid.'.'.$respid};
my @rowdata = ('Foil Name','Foil Text','Frequency');
$worksheet->write_row($rows_output++,0,
\@rowdata,$format->{'h4'});
my @foils = sort(keys(%{$respdata->{'_Foils'}}));
foreach my $foilid (@foils) {
undef(@rowdata);
my $value = $data->{'map_fv'}->{$foilid};
push(@rowdata,$respdata->{'_Foils'}->{$foilid}->{'name'});
push(@rowdata,$respdata->{'_Foils'}->{$foilid}->{'text'});
push(@rowdata,$data->{'foil_values'}->{$value});
$worksheet->write_row($rows_output++,0,\@rowdata);
}
}
$rows_output++;
} #response ids
} # partids
$workbook->close();
$r->print('<p><a href="'.$filename.'">'.
&mt('Your Excel spreadsheet.').
'</a></p>'."\n");
$r->print('<script>'.
'window.document.Statistics.stats_status.value="'.
&mt('Done compiling spreadsheet. See link below to download.').
'";</script>');
$r->rflush();
return;
}
#########################################################
#########################################################
##
## make_HTML_report
##
#########################################################
#########################################################
sub make_HTML_report {
my ($r,$problem,$ProblemData,$Students) = @_;
my $resource = $problem->{'resource'};
foreach my $partid (@{$resource->parts}) {
my @response_ids = $resource->responseIds($partid);
my @response_types = $resource->responseType($partid);
for (my $i=0;$i<=$#response_ids;$i++) {
my $Str = '<table>'.$/;
my $respid = $response_ids[$i];
my $resptype = $response_types[$i];
my $data = $problem->{'responsedata'}->{$partid}->{$respid};
if (! defined($data) || ref($data) ne 'HASH') {
next;
}
# Debugging code
# $Str .= '<tr>'.
# '<td>'.$partid.'</td>'.
# '<td>'.$respid.'</td>'.
# '<td>'.$resptype.'</td>'.
# '</tr>'.$/;
$Str .= '<tr>'.
'<td><b>'.&mt('Total').'</b></td>'.
'<td>'.$data->{'_count'}.'</td>'.
'<td>'.&mt('Part [_1], Response [_2]',
$resource->part_display($partid),$respid).'</td>'.
'</tr>';
if (exists($data->{'responses'}) &&
ref($data->{'responses'}) eq 'ARRAY') {
&randomize_array($data->{'responses'});
foreach my $response (@{$data->{'responses'}}) {
$response =~ s/\\r\\n/\n/g;
$response =~ s/\\'/'/g;
$response =~ s/\\"/"/g;
$Str .= '<tr>'.
'<td colspan="3"><pre>'.
&HTML::Entities::encode($response,'<>&').
'</pre><hr /></td>'.
'</tr>'.$/;
}
} elsif (exists($data->{'foil_count'}) &&
exists($data->{'foil_responses'})) {
$Str.='<tr><td colspan="3">'.
'<table><tr>';
my $tmp = '<th>'.join('</th><th>',
(&mt('Foil Name'),
&mt('Foil Text'),
&mt('Option'),
&mt('Frequency'),
&mt('Percent'))).'</th></tr>';
my @foils = sort(keys(%{$ProblemData->{$partid.'.'.$respid}->{'_Foils'}}));
foreach my $foilid (@foils) {
my $prob_data = $ProblemData->{$partid.'.'.$respid};
my $foil_count = $data->{'foil_count'}->{$foilid};
my $foiltext = $prob_data->{'_Foils'}->{$foilid}->{'text'};
my $foilname = $prob_data->{'_Foils'}->{$foilid}->{'name'};
my $rowspan = scalar(@{$prob_data->{'_Options'}});
my $preamble = '<tr>'.
'<td valign="top" rowspan="'.$rowspan.'">'.
$foilname.'</td>'.
'<td valign="top" rowspan="'.$rowspan.'">'.
$foiltext.'</td>';
foreach my $option (sort(@{$prob_data->{'_Options'}})){
my $count =
$data->{'foil_responses'}->{$foilid}->{$option};
$tmp .= $preamble.
'<td>'.$option.'</td>'.
'<td align="right">'.$count.'</td>'.
'<td align="right">'.
sprintf('%.2f',100*$count/$foil_count).'%'.
'</td></tr>'.$/;
$preamble = '<tr>';
}
}
$Str.=$tmp.'</table></td></tr>';
} elsif (exists($data->{'_count'}) &&
exists($data->{'foil_values'}) &&
exists($data->{'map'})) {
# This is an option or radiobutton survey response
my $total = $data->{'_count'};
my $sum = 0;
my $tmp;
my @foils = sort(keys(%{$ProblemData->{$partid.'.'.$respid}
->{'_Foils'}}));
foreach my $foilid (@foils) {
my $value = $data->{'map_fv'}->{$foilid};
my $count = $data->{'foil_values'}->{$value};
my $foiltext = $ProblemData->{$partid.'.'.$respid}->{'_Foils'}->{$foilid}->{'text'};
my $foilname = $ProblemData->{$partid.'.'.$respid}->{'_Foils'}->{$foilid}->{'name'};
$tmp .= '<tr>'.
'<td>'.$foilname.'</td>'.
'<td>'.$foiltext.'</td>'.
'<td align="right">'.$count.'</td>'.
'<td align="right">'.
sprintf("%.2f",$count/$total*100).'%</td>'.
'</tr>'.$/;
}
$Str .= '<tr>'.
'<th>'.&mt('Foil Name').'</th>'.
'<th>'.&mt('Text').'</th>'.
'<th>'.&mt('Freq').'</th>'.
'<th>'.&mt('Percent').'</th>'.
'</tr>'.$/.
$tmp;
}
$Str.= '</table><hr />';
$r->print($Str);
$r->rflush();
}
}
return;
}
sub randomize_array {
# Fisher Yates shuffle, lifted from p 121 of "The Perl Cookbook"
my ($array) = @_;
for (my $i=scalar(@$array);--$i;) {
my $j = int(rand($i+1));
next if ($i == $j);
@$array[$i,$j]=@$array[$j,$i];
}
}
#########################################################
#########################################################
##
## Generic Interface Routines
##
#########################################################
#########################################################
sub CreateInterface {
##
## Environment variable initialization
my $Str = '';
my $output_selector = '<select name="output" size="5">'.$/;
if (! exists($env{'form.output'})) {
$env{'form.output'} = 'HTML';
}
foreach my $output_format ( {name=>'HTML',text=>&mt("HTML") },
{name=>'Excel',text=>&mt("Excel") },
{name=>'TXT',text=>&mt("Text (essays only)") },
) {
$output_selector.='<option value="'.$output_format->{'name'}.'"';
if ($env{'form.output'} eq $output_format->{'name'}) {
$output_selector.=' selected';
}
$output_selector.= '>'.$output_format->{'text'}.'</option>'.$/;
}
$output_selector .= '</select>'.$/;
$Str .= &Apache::lonhtmlcommon::breadcrumbs('Student Submission Reports');
$Str .= '<p>';
$Str .= '<table cellspacing="5">'."\n";
$Str .= '<tr>';
$Str .= '<th>'.&mt('Sections').'</th>';
$Str .= '<th>'.&mt('Groups').'</th>';
$Str .= '<th>'.&mt('Access Status').'</th>';
$Str .= '<th>'.&mt('Output Format').'</th>';
$Str .= '<th>'.' '.'</th>';
$Str .= '</tr>'."\n";
#
$Str .= '<tr><td align="center">'."\n";
$Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
$Str .= '</td>';
#
$Str .= '<td align="center">'."\n";
$Str .= &Apache::lonstatistics::GroupSelect('Group','multiple',5);
$Str .= '</td>';
#
$Str .= '<td align="center">';
$Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
$Str .= '</td>';
#
$Str .= '<td align="center">'.$output_selector.'</td>';
#
# Render problem checkbox
my $prob_checkbox = '<input type="checkbox" name="renderprob" ';
if (exists($env{'form.renderprob'}) && $env{'form.renderprob'} eq 'true') {
$prob_checkbox .= 'checked ';
}
$prob_checkbox .= 'value="true" />';
$Str .= '<td align="right" valign="top">'.
'<label><b>'.
&mt('Show problem [_1]',$prob_checkbox).'</b></label><br />'.
'<label><b>'.
'</td>';
#
$Str .= '</tr>'."\n";
$Str .= '</table>'."\n";
#
$Str .= '<nobr>'.&mt('Status: [_1]',
'<input type="text" '.
'name="stats_status" size="60" value="" />').
'</nobr>'.'</p>';
##
return $Str;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonsurveyreports.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface / statistics