'."\n";
+ my ($r,$c)=@_;
+ #
+ my %Saveable_Parameters = ('Status' => 'scalar',
+ 'statsoutputmode' => 'scalar',
+ 'Section' => 'array',
+ 'StudentData' => 'array',
+ 'Maps' => 'array');
+ &Apache::loncommon::store_course_settings('statistics',
+ \%Saveable_Parameters);
+ &Apache::loncommon::restore_course_settings('statistics',
+ \%Saveable_Parameters);
+ #
+ &Apache::lonstatistics::PrepareClasslist();
+ #
+ # Clear the package variables
+ undef(@StatsArray);
+ #
+ # Finally let the user know we are here
+ my $interface = &CreateInterface();
+ $r->print($interface);
+ $r->print('');
+ #
+ if (! exists($ENV{'form.statsfirstcall'})) {
+ $r->print('');
+ $r->print('
'.
+ &mt('Press "Generate Statistics" when you are ready.').
+ '
'.
+ &mt('It may take some time to update the student data '.
+ 'for the first analysis. Future analysis this session '.
+ ' will not have this delay.').
+ '
'."\n";
- $r->print($Result);
$r->rflush();
+ #
+ # This probably does not need to be done each time we are called, but
+ # it does not slow things down noticably.
+ &Apache::loncoursedata::populate_weight_table();
+ #
+ if (exists($ENV{'form.Excel'})) {
+ &Excel_output($r);
+ } else {
+ my $count = 0;
+ foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+ $count += $seq->{'num_assess'};
+ }
+ if ($count > 10) {
+ $r->print('
'.
+ &mt('Compiling statistics for [_1] problems',$count).
+ '
\n");
+ return;
+}
-
-# ------ Dump the Student's DB file and handling the data for statistics table
-sub ExtractStudentData {
- my ($cache,$name,$list,$Discuss,$r,$discriminant)=@_;
- my $totalTries = 0;
- my $totalAwarded = 0;
- my $spent=0;
- my $spent_yes=0;
- my $TotDiscuss=0;
- my $TotalOpend = 0;
- my $ProbSolved = 0;
- my $ProbTot = 0;
- my $TotFirst = 0;
- my $TimeTot = 0;
- my $Discussed=0;
- my $discrim='';
- my $tempSequenceOrder=100;
-
-#$Apache::lonxml::debug=1;
-#&Apache::lonhomework::showhash(%$cache);
-#$Apache::lonxml::debug=0;
-
- foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
- my $tempProblemOrder=100;
- $tempSequenceOrder++;
-# if($cache->{'ProblemStatisticsMap'} ne 'All Maps' &&
-# $cache->{'ProblemStatisticsMap'} ne $cache->{$sequence.':title'}) {
-# $r->print(" sequences=$cache->{'orderedSequences'}");
-# $r->print(" ".$cache->{$sequence.':title'});
-# next;
-# }
-
- #$discrim .= '&';
- foreach my $problemID (split(':', $cache->{$sequence.':problems'})) {
-# $r->print(" problems=$cache->{$sequence.':problems'}");
- my $problem = $cache->{$problemID.':problem'};
-# $r->print(" $problemID === $problem");
- my $LatestVersion = $cache->{$name.':version:'.$problem};
- # Output dashes for all the parts of this problem if there
- # is no version information about the current problem.
- #if(!$LatestVersion) {
- # foreach my $part (split(/\:/,$cache->{$sequence.':'.
- # $problemID.
- # ':parts'})) {
- # $codes .= "-,";
- # $attempts .= "0,";
- # }
- # next;
- #}
-
- my %partData=undef;
- $partData{'count'}=0;
- # Initialize part data, display skips correctly
- # Skip refers to when a student made no submissions on that
- # part/problem.
- foreach my $part (split(/\:/,$cache->{$sequence.':'.
- $problemID.
- ':parts'})) {
- $tempProblemOrder++;
- $partData{'count'}++;
-# $r->print(" parts=$cache->{$sequence.':'.$problemID.':parts'}");
- $partData{$part.':order'}=$tempProblemOrder;
- $partData{$part.':tries'}=0;
- $partData{$part.':code'}='-';
- }
+sub html_preamble {
+ my $Str='';
+ $Str .= "
\n";
+ my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits();
+ if (defined($starttime) || defined($endtime)) {
+ # Inform the user what the time limits on the data are.
+ $Str .= '
'.&mt('Statistics on submissions from [_1] to [_2]',
+ &Apache::lonlocal::locallocaltime($starttime),
+ &Apache::lonlocal::locallocaltime($endtime)
+ ).'
';
+ }
+ $Str .= "
".&mt('Compiled on [_1]',
+ &Apache::lonlocal::locallocaltime(time))."
";
+ return $Str;
+}
- # Looping through all the versions of each part, starting with the
- # oldest version. Basically, it gets the most recent
- # set of grade data for each part.
- for(my $Version=1; $Version<=$LatestVersion; $Version++) {
- foreach my $part (split(/\:/,$cache->{$sequence.':'.
- $problemID.
- ':parts'})) {
-
- if(!defined($cache->{$name.":$Version:$problem".
- ":resource.$part.solved"})) {
- # No grade for this submission, so skip
- next;
- }
- my $tries=0;
- my $time=0;
- my $awarded=0;
- $Discussed=0;
- my $code='-';
-
- $awarded = $cache->{"$name:$Version:$problem:resource.".
- "$part.awarded"};
- $partData{$part.':awarded'} = ($awarded) ? $awarded : 0;
- $totalAwarded += $awarded;
-
- $tries = $cache->{"$name:$Version:$problem".
- ":resource.$part.tries"};
- $partData{$part.':tries'} = ($tries) ? $tries : 0;
- $partData{$part.':wrong'} = $partData{$part.':tries'};
- $totalTries += $tries;
-
- my $val = $cache->{$name.":$Version:$problem".
- ":resource.$part.solved"};
- if ($val eq 'correct_by_student') {$code = 'C';}
- elsif ($val eq 'correct_by_override') {$code = 'O';}
- elsif ($val eq 'incorrect_attempted') {$code = 'I';}
- elsif ($val eq 'incorrect_by_override'){$code = 'I';}
- elsif ($val eq 'excused') {$code = 'x';}
- $partData{$part.':code'}=$code;
- if($partData{$part.':wrong'} ne 0 &&
- ($code eq 'C' || $code eq 'O')) {
- $partData{$part.':wrong'}--;
- }
- }
+###############################################
+###############################################
+##
+## Misc HTML output routines
+##
+###############################################
+###############################################
+sub statistics_html_table_data {
+ my ($data,$options) = @_;
+ my $row = '';
+ foreach my $field (@Fields) {
+ next if ($options =~ /no $field->{'name'}/);
+ $row .= '
Total Number of Students opened the problem.';
- $Ptr .= '
';
- $Ptr .= 'Tries
';
- $Ptr .= '
Total Number of Tries for solving the problem.';
- $Ptr .= '
';
- $Ptr .= 'Mod
';
- $Ptr .= '
Maximunm Number of Tries for solving the problem.';
- $Ptr .= '
';
- $Ptr .= 'Mean
';
- $Ptr .= '
Average Number of the tries. [ Tries / #Stdnts ]';
- $Ptr .= '
';
- $Ptr .= '#YES
';
- $Ptr .= '
Number of students solved the problem correctly.';
- $Ptr .= '
';
- $Ptr .= '#yes
';
- $Ptr .= '
Number of students solved the problem by override.';
- $Ptr .= '
';
- $Ptr .= '%Wrng
';
- $Ptr .= '
Percentage of students tried to solve the problem ';
- $Ptr .= 'but still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]';
- $Ptr .= '
';
- $Ptr .= 'DoDiff
';
- $Ptr .= '
Degree of Difficulty of the problem. ';
- $Ptr .= '[ 1 - ((#YES+#yes) / Tries) ]';
- $Ptr .= '
';
- $Ptr .= 'S.D.
';
- $Ptr .= '
Standard Deviation of the tries. ';
- $Ptr .= '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) ';
- $Ptr .= 'where Xi denotes every student\'s tries ]';
- $Ptr .= '
';
- $Ptr .= 'Skew.
';
- $Ptr .= '
Skewness of the students tries.';
- $Ptr .= '[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]';
- $Ptr .= '
';
- $Ptr .= 'Dis.F.
';
- $Ptr .= '
Discrimination Factor: A Standard for evaluating the ';
- $Ptr .= 'problem according to a Criterion ';
- $Ptr .= '[Applied Criterion in %27 Upper Students - ';
- $Ptr .= 'Applied the same Criterion in %27 Lower Students] ';
- $Ptr .= '1st Criterion for Sorting the Students: ';
- $Ptr .= 'Sum of Partial Credit Awarded / Total Number of Tries ';
- $Ptr .= '2nd Criterion for Sorting the Students: ';
- $Ptr .= 'Total number of Correct Answers / Total Number of Tries';
- $Ptr .= '
';
- $Ptr .= '
Disc.
';
- $Ptr .= '
Number of Students had at least one discussion.';
- $Ptr .= '
';
-
- return $Ptr;
-}
-
-#------- Processing upperlist and lowerlist according to each problem
-sub ProcessDiscriminant {
- my ($List,$r) = @_;
- my @sortedList = sort (@$List);
- my $Count = scalar @sortedList;
- my $Problem;
- my @Dis;
- my $Slvd=0;
- my $tmp;
- my $Sum1=0;
- my $Sum2=0;
- my $nIndex=0;
- my $nStudent=0;
- my %Proc=undef;
- while ($nIndex<$Count) {
-# $r->print(" $nIndex) $sortedList[$nIndex]");
- ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]);
- @Dis=split(/\+/,$tmp);
- my $Temp = $Problem;
- do {
- $nIndex++;
- $nStudent++;
- $Sum1 += $Dis[0];
- $Sum2 += $Dis[1];
- ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]);
- @Dis=split(/\+/,$tmp);
- } while ( $Problem eq $Temp && $nIndex < $Count );
- $Proc{$Temp}=($Sum1/$nStudent).':'.($Sum2/$nStudent);
-# $r->print(" $nIndex) $Temp --> ($nStudent) $Proc{$Temp}");
- $Sum1=0;
- $Sum2=0;
- $nStudent=0;
- }
-
- return %Proc;
-}
-
-#------- Creating Discimination factor
-sub Discriminant {
- my ($discriminant,$r)=@_;
-#$Apache::lonxml::debug=1;
-#&Apache::lonhomework::showhash(%$discriminant);
-#$Apache::lonxml::debug=0;
- my @discriminantKeys=keys(%$discriminant);
- my $Count = scalar @discriminantKeys;
-
- my $UpCnt = int(0.27*$Count);
- my $low=0;
- my $up=$Count-$UpCnt;
- my @UpList=();
- my @LowList=();
-
- $Count=0;
- foreach my $key (sort(@discriminantKeys)) {
- $Count++;
- if($low < $UpCnt || $Count > $up) {
- $low++;
- my $str=$discriminant->{$key};
- foreach(split(/\&/,$str)){
- if($_) {
- if($low<$UpCnt) { push(@LowList,$_); }
- else { push(@UpList,$_); }
- }
- }
- }
- }
- my %DisUp = &ProcessDiscriminant(\@UpList,$r);
- my %DisLow = &ProcessDiscriminant(\@LowList,$r);
+###############################################
+###############################################
- return (\%DisUp, \%DisLow);
-}
+=pod
-
+=item ProblemStatisticsLegend
-#---- END Problem Statistics Web Page ----------------------------------------
+=over 4
-#---- Problem Statistics Graph Web Page --------------------------------------
+=item #Stdnts
+Total number of students attempted the problem.
-# ------------------------------------------- Prepare data for Graphical chart
+=item Tries
+Total number of tries for solving the problem.
-sub BuildDiffGraph {
- my ($r)=@_;
+=item Max Tries
+Largest number of tries for solving the problem by a student.
+
+=item Mean
+Average number of tries. [ Tries / #Stdnts ]
+
+=item #YES
+Number of students solved the problem correctly.
+
+=item #yes
+Number of students solved the problem by override.
+
+=item %Wrong
+Percentage of students who tried to solve the problem
+but is still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]
+
+=item DoDiff
+Degree of Difficulty of the problem.
+[ 1 - ((#YES+#yes) / Tries) ]
+
+=item S.D.
+Standard Deviation of the tries.
+[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1)
+where Xi denotes every student\'s tries ]
+
+=item Skew.
+Skewness of the students tries.
+[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]
+
+=item Dis.F.
+Discrimination Factor: A Standard for evaluating the
+problem according to a Criterion
+
+=item [Criterion to group students into %27 Upper Students -
+and %27 Lower Students]
+1st Criterion for Sorting the Students:
+Sum of Partial Credit Awarded / Total Number of Tries
+2nd Criterion for Sorting the Students:
+Total number of Correct Answers / Total Number of Tries
+
+=item Disc.
+Number of Students had at least one discussion.
- my $graphData = &GetGraphData('DiffGraph', $r);
- return '';
+=back
+
+=cut
+
+
+############################################################
+############################################################
+##
+## How this all works:
+## Statistics are computed by calling &get_statistics with the sequence,
+## resource, and part id to run statistics on. At various places within
+## the loops which compute the statistics, as well as before and after
+## the entire process, subroutines can be called. The subroutines are
+## registered to the following hooks:
+##
+## hook subroutine inputs
+## ----------------------------------------------------------
+## pre $r,$count
+## pre_seq $r,$count,$seq
+## pre_res $r,$count,$seq,$res
+## calc $r,$count,$seq,$res,$data
+## post_res $r,$count,$seq,$res
+## post_seq $r,$count,$seq
+## post $r,$count
+##
+## abort $r
+##
+## subroutines will be called in the order in which they are registered.
+##
+############################################################
+############################################################
+{
+
+my %hooks;
+my $aborted = 0;
+
+sub abort_computation {
+ $aborted = 1;
}
-sub BuildWrongGraph {
- my ($r)=@_;
+sub clear_hooks {
+ $aborted = 0;
+ undef(%hooks);
+}
- my $graphData = &GetGraphData('WrongGraph', $r);
- return '';
+sub register_hook {
+ my ($hookname,$subref)=@_;
+ if ($hookname !~ /^(pre|pre_seq|pre_res|post|post_seq|post_res|calc)$/){
+ return;
+ }
+ if (ref($subref) ne 'CODE') {
+ &Apache::lonnet::logthis('attempt to register hook to non-code: '.
+ $hookname,' = '.$subref);
+ } else {
+ if (exists($hooks{$hookname})) {
+ push(@{$hooks{$hookname}},$subref);
+ } else {
+ $hooks{$hookname} = [$subref];
+ }
+ }
+ return;
}
+sub run_hooks {
+ my $context = shift();
+ foreach my $hook (@{$hooks{$context}}) {
+ if ($aborted && $context ne 'abort') {
+ last;
+ }
+ my $retvalue = $hook->(@_);
+ if (defined($retvalue) && $retvalue eq '0') {
+ $aborted = 1 if (! $aborted);
+ }
+ }
+}
-sub GetGraphData {
- my ($ylab,$r,%GraphDat)=@_;
- my $Col;
- my $data='';
+sub run_statistics {
+ my ($r) = @_;
my $count = 0;
- my $Max = 0;
- my $cid=$ENV{'request.course.id'};
- my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
- "_$ENV{'user.domain'}_$cid\_graph.db";
- foreach (keys %GraphDat) {delete $GraphDat{$_};}
- if (-e "$GraphDB") {
- if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) {
- if ( $ylab eq 'DoDiff Graph' ) {
- $ylab = 'Degree-of-Difficulty';
- $Col = 0;
- }
- else {
- $ylab = 'Wrong-Percentage';
- $Col = 1;
- }
- foreach (sort NumericSort keys %GraphDat) {
- my @Temp=split(/\:/,$GraphDat{$_});
- my $inf = $Temp[$Col];
- if ( $Max < $inf ) {$Max = $inf;}
- $data .= $inf.',';
- $count++;
- }
- if ( $Max > 1 ) {
- $Max += (10 - $Max % 10);
- $Max = int($Max);
- }
- else { $Max = 1; }
- untie(%GraphDat);
- my $Course = $ENV{'course.'.$cid.'.description'};
- $Course =~ s/\ /"_"/eg;
- my $GData=$Course.'&'.'Problems'.'&'.$ylab.'&'.
- $Max.'&'.$count.'&'.$data;
- }
- else {
- $r->print("Unable to tie hash to db file");
- }
+ &run_hooks('pre',$r,$count);
+ foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+ last if ($aborted);
+ next if ($seq->{'num_assess'}<1);
+ &run_hooks('pre_seq',$r,$count,$seq);
+ foreach my $res (@{$seq->{'contents'}}) {
+ last if ($aborted);
+ next if ($res->{'type'} ne 'assessment');
+ &run_hooks('pre_res',$r,$count,$seq,$res);
+ foreach my $part (@{$res->{'parts'}}) {
+ last if ($aborted);
+ #
+ # This is where all the work happens
+ my $data = &get_statistics($seq,$res,$part,++$count);
+ &run_hooks('calc',$r,$count,$seq,$res,$part,$data);
+ }
+ &run_hooks('post_res',$r,$count,$seq,$res);
+ }
+ &run_hooks('post_seq',$r,$count,$seq);
}
+ if ($aborted) {
+ &run_hooks('abort',$r);
+ } else {
+ &run_hooks('post',$r,$count);
+ }
+ return;
}
+} # End of %hooks scope
+
+############################################################
+############################################################
1;
__END__
';
+=back
+
+=cut
+
+
+############################################################
+############################################################
+##
+## How this all works:
+## Statistics are computed by calling &get_statistics with the sequence,
+## resource, and part id to run statistics on. At various places within
+## the loops which compute the statistics, as well as before and after
+## the entire process, subroutines can be called. The subroutines are
+## registered to the following hooks:
+##
+## hook subroutine inputs
+## ----------------------------------------------------------
+## pre $r,$count
+## pre_seq $r,$count,$seq
+## pre_res $r,$count,$seq,$res
+## calc $r,$count,$seq,$res,$data
+## post_res $r,$count,$seq,$res
+## post_seq $r,$count,$seq
+## post $r,$count
+##
+## abort $r
+##
+## subroutines will be called in the order in which they are registered.
+##
+############################################################
+############################################################
+{
+
+my %hooks;
+my $aborted = 0;
+
+sub abort_computation {
+ $aborted = 1;
}
-sub BuildWrongGraph {
- my ($r)=@_;
+sub clear_hooks {
+ $aborted = 0;
+ undef(%hooks);
+}
- my $graphData = &GetGraphData('WrongGraph', $r);
- return '