--- loncom/interface/statistics/lonproblemanalysis.pm	2005/02/16 17:43:20	1.111
+++ loncom/interface/statistics/lonproblemanalysis.pm	2005/02/22 04:32:46	1.112
@@ -1,6 +1,6 @@
 # The LearningOnline Network with CAPA
 #
-# $Id: lonproblemanalysis.pm,v 1.111 2005/02/16 17:43:20 matthew Exp $
+# $Id: lonproblemanalysis.pm,v 1.112 2005/02/22 04:32:46 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -260,9 +260,10 @@ sub numerical_response_analysis {
                                          $respid,$students);
         if ($c->aborted()) { return; };
         #
-        my $responses = &numerical_classify_responses($response_data,$correct,
-                                                      $restriction_function);
-        if ($responses->{'_count'} == 0) {
+        my ($responses,$stats) = 
+            &numerical_classify_responses($response_data,$correct,
+                                          $restriction_function);
+        if ($stats->{'submission_count'} == 0) {
             $analysis_html.= 
                 '<tr><td colspan="2"><font size="+1"><b>'.
                 &mt($no_data_message,$plot_num,@extra_data).
@@ -274,16 +275,16 @@ sub numerical_response_analysis {
                 '</b></font></td></tr>'.
                 '<tr><td colspan="2" align="center">'.
                 &mt($stats_message,
-                    $responses->{'_count'},
-                    $responses->{'_correct'},
-                    $responses->{'_count'}-$responses->{'_correct'},
-                    $responses->{'_students'},
+                    $stats->{'submission_count'},
+                    $stats->{'correct_count'},
+                    $stats->{'incorrect_count'},
+                    $stats->{'students'},
                     @extra_data).
                     '</td></tr>'.
                     '<tr>'.'<td valign="top" align="center">'.
-                    &numerical_plot_percent($r,$responses).'</td>'.
+                    &numerical_plot_percent($r,$responses,$stats).'</td>'.
                     '<td align="center" valign="top">'.
-                    &numerical_plot_differences($r,$responses).'</td>'.
+                    &numerical_plot_differences($r,$responses,$stats).'</td>'.
                     '</tr>';
         }
         if ($post_message ne '') {
@@ -298,40 +299,22 @@ sub numerical_response_analysis {
 }
 
 sub numerical_plot_percent {
-    my ($r,$responses) = @_;
+    my ($r,$responses,$stats) = @_;
     #
-    my $total = $responses->{'_count'};
+    my $total = $stats->{'submission_count'};
     return '' if ($total == 0);
-    my $minbin = 5;
-    while (my ($interval,$submissions) = each(%$responses)) {
-        next if ($interval =~ /^_/);
-        my ($ans,$ans_low,$ans_high) = split(" ",$interval);
-        my $low_percent  = abs(100*($ans-$ans_low)/$ans);
-        my $high_percent = abs(100*($ans_high-$ans)/$ans);
-        if ($minbin > $high_percent) { $minbin = $high_percent; }
-        if ($minbin > $low_percent) { $minbin = $low_percent; }
-    }
-    #
+    my $min_bin_size = $stats->{'min_abs'};
+    my $low_bin  = $stats->{'lowest_ans'}-$stats->{'max_bin_size'};
+    my $high_bin = $stats->{'highest_ans'}+$stats->{'max_bin_size'};
     my @bins;
-    if ($minbin < 1) {
-        @bins = ('0.1','0.5','1.0','1.5','2.0','2.5','3.0','4.0','5.0',10,20,50,100);        
-    } elsif ($minbin < 2) {
-        @bins = ('0.5','1.0','1.5','2.0','2.5','3.0','4.0','5.0',10,20,50,100);
-    } elsif ($minbin < 5) {
-        @bins = (1,2,3,4,5,10,25,50,75,100,200);
-    } elsif ($minbin < 10) {
-        @bins = (2,4,6,8,10,12,15,20,25,30,50,75,100,200);
-    } else {
-        @bins = (5,10,15,20,25,30,50,75,100,200);
+    for (my $num = $low_bin;$num <= $high_bin;$num+=($min_bin_size/2)) {
+        push(@bins,$num);
     }
-    my @labels = (1..scalar(@bins));
     #
     my @correct;
     my @incorrect;
     my @count;
-    while (my ($interval,$submissions) = each(%$responses)) {
-        next if ($interval =~ /^_/);
-        my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+    while (my ($ans,$submissions) = each(%$responses)) {
         while (my ($submission,$counts) = each(%$submissions)) {
             my ($correct_count,$incorrect_count) = @$counts;
             my $scaled_value = abs(($submission-$ans)/$ans);
@@ -345,13 +328,32 @@ sub numerical_plot_percent {
         }
     }
     #
-    my @plot_correct;
-    my @plot_incorrect;
+    # Skip empty bins
+    my (@plot_correct,@plot_incorrect,@new_bins,@new_count);
+    my $min_skip = 2;
     for (my $i=0;$i<=$#bins;$i++) {
-        $plot_correct[$i] = $correct[$i]*100/$total;
-        $plot_incorrect[$i] = $incorrect[$i]*100/$total;
+        my $sum=0;
+        for (my $j=-$min_skip;$j<=$min_skip && $i+$j<=$#bins;$j++) {
+            $sum += $correct[$i+$j] + $incorrect[$i+$j];
+        }
+        if ($sum) {
+            push(@new_bins,$bins[$i]);
+            push(@plot_correct,$correct[$i]);
+            push(@plot_incorrect,$incorrect[$i]);
+            push(@new_count,$correct[$i]+$incorrect[$i]);
+        }
     }
+    @correct   = @plot_correct;
+    @incorrect = @plot_incorrect;
+    @count     = @new_count;
+    @bins      = @new_bins;
+    for (my $i=0;$i<=$#bins;$i++) {
+        $plot_correct[$i]   *= 100/$total;
+        $plot_incorrect[$i] *= 100/$total;
+    }
+    #
     my $title = &mt('Distribution by Percent');
+    my @labels = (1..scalar(@bins));
     my $graph = &Apache::loncommon::DrawBarGraph
         ($title,'Percent difference from correct','Number of answers',
          100,['#33FF00','#FF3300'],\@labels,\@plot_correct,\@plot_incorrect,
@@ -363,41 +365,24 @@ sub numerical_plot_percent {
 }
 
 sub numerical_plot_differences {
-    my ($r,$responses) = @_;
+    my ($r,$responses,$stats) = @_;
     #
-    my $total = $responses->{'_count'};
+    my $total = $stats->{'submission_count'};
     return '' if ($total == 0);
-    my $minbin = undef;
-    my $maxbin = undef;
-    while (my ($interval,$submissions) = each(%$responses)) {
-        next if ($interval =~ /^_/);
-        my ($ans,$ans_low,$ans_high) = split(" ",$interval);
-        my $low_diff  = abs($ans-$ans_low);
-        my $high_diff = abs($ans_high-$ans);
-        if (! defined($maxbin)) { $maxbin = $low_diff;}
-        if (! defined($minbin)) { $minbin = $low_diff;}
-        #
-        if ($minbin > $high_diff) { $minbin = $high_diff; }
-        if ($minbin > $low_diff ) { $minbin = $low_diff; }
-        #
-        if ($maxbin < $high_diff) { $maxbin = $high_diff; }
-        if ($maxbin < $low_diff ) { $maxbin = $low_diff; }
-    }    
     #
     my @bins;
     my @labels;
     # Hmmmm, should switch to absolute difference
     for (my $i=1;$i<=20;$i++) {
-        push(@bins,$i*$minbin/2);
+        push(@bins,$i/2);
         push(@labels,$i);
     }
     #
     my @correct;
     my @incorrect;
     my @count;
-    while (my ($interval,$submissions) = each(%$responses)) {
-        next if ($interval =~ /^_/);
-        my ($ans,$ans_low,$ans_high) = split(" ",$interval);
+    while (my ($ans,$submissions) = each(%$responses)) {
+        next if ($ans =~ /^_/);
         while (my ($submission,$counts) = each(%$submissions)) {
             my ($correct_count,$incorrect_count) = @$counts;
             my $value = abs($submission-$ans);
@@ -429,60 +414,95 @@ sub numerical_plot_differences {
 }
 
 sub numerical_classify_responses {
-    &Apache::lonnet::logthis('--------------');
     my ($full_row_data,$correct,$function) = @_;
     my %submission_data;
     my %students;
+    my %stats;
     my $max=0;
     foreach my $row (@$full_row_data) {
-#        &Apache::lonnet::logthis(' row = '.join(',',@$row));
         my %subm = &hashify_attempt($row);
         if (ref($correct) eq 'HASH') {
-            $subm{'correct'} = $correct->{$subm{'student'}}->{'answer'};
-            $subm{'unit'} = $correct->{$subm{'student'}}->{'unit'};
+            my $s_correct = $correct->{$subm{'student'}};
+            $subm{'correct'} = $s_correct->{'answer'};
+            foreach my $item ('unit','ans_low','ans_high') {
+                $subm{$item} = $s_correct->{$item};
+            }
         } else { # This probably never happens....
             $subm{'correct'} = $correct->{'answer'};
             $subm{'unit'} = $correct->{'unit'};
         }
+        # 
+        my $abs_low =abs($subm{'correct'}-$subm{'ans_low'});
+        my $abs_high=abs($subm{'correct'}-$subm{'ans_high'});
+        if (! defined($stats{'min_abs'}) ||
+            $stats{'min_abs'} > $abs_low) {
+            $stats{'min_abs'} = $abs_low;
+        }
+        if ($stats{'min_abs'} > $abs_high) {
+            $stats{'min_abs'} = $abs_high;
+        }
+        if (! defined($stats{'max_abs'}) ||
+            $stats{'max_abs'} < $abs_low) {
+            $stats{'max_abs'} = $abs_low;
+        }
+        if ($stats{'max_abs'} < $abs_high) {
+            $stats{'max_abs'} = $abs_high;
+        }
+        my $low_percent  = 100 * abs($abs_low  / $subm{'correct'});
+        my $high_percent = 100 * abs($abs_high / $subm{'correct'});
+        if (! defined($stats{'min_percent'}) ||
+            $stats{'min_percent'} > $low_percent) {
+            $stats{'min_percent'} = $low_percent;
+        }
+        if ($stats{'min_percent'} > $high_percent) {
+            $stats{'min_percent'} = $high_percent;
+        }
+        if (! defined($stats{'max_percent'}) ||
+            $stats{'max_percent'} < $low_percent) {
+            $stats{'max_percent'} = $low_percent;
+        }
+        if ($stats{'max_percent'} < $high_percent) {
+            $stats{'max_percent'} = $high_percent;
+        }
+        if (! defined($stats{'lowest_ans'}) ||
+            $stats{'lowest_ans'} > $subm{'correct'}) {
+            $stats{'lowest_ans'} = $subm{'correct'};
+        }
+        if (! defined($stats{'highest_ans'}) ||
+            $stats{'highest_ans'} < $subm{'correct'}) {
+            $stats{'highest_ans'} = $subm{'correct'};
+        }
+        # 
         $subm{'submission'} =~ s/=\d+\s*$//;
         if (&$function(\%subm)) {
             my $scaled = '1';
             my ($sname,$sdom) = split(':',$subm{'student'});
-            # Note that $subm{'unit'} is modified by the following call
-            # We do not use it again but you should be aware just in case.
             my ($myunit,$mysub) = ($subm{'unit'},$subm{'submission'});
             my $result = 
                 &capa::caparesponse_get_real_response($myunit,
                                                       $mysub,
                                                       \$scaled);
+            &Apache::lonnet::logthis('scaled = '.$scaled.' result ='.$result);
             next if (! defined($scaled));
-            next if ($result ne '6');
+#            next if ($result ne '6');
             my $submission = $scaled;
             $students{$subm{'student'}}++;
+            $stats{'submission_count'}++;
             if (&numerical_submission_is_correct($subm{'award'})) { 
-                &Apache::lonnet::logthis('correct:'.$submission.':'.$subm{'correct'});
-                $submission_data{'_correct'}++;
-                $submission_data{'_count'}++;
+                $stats{'correct_count'}++;
                 $submission_data{$subm{'correct'}}->{$submission}->[0]++;
             } elsif (&numerical_submission_is_incorrect($subm{'award'})) { 
-                &Apache::lonnet::logthis('incorrect:'.$submission.':'.$subm{'correct'});
-                $submission_data{'_count'}++;
+                $stats{'incorrect_count'}++;
                 $submission_data{$subm{'correct'}}->{$submission}->[1]++;
             }
-            my $value = 
-                $submission_data{$subm{'correct'}}->{$submission}->[0]+ 
-                $submission_data{$subm{'correct'}}->{$submission}->[1];
-            if ($max < $value) { $max = $value; }
         }
     }
-    $submission_data{'_max'} = $max;
-    $submission_data{'_students'}=scalar(keys(%students));
-    return \%submission_data;
+    $stats{'students'}=scalar(keys(%students));
+    return (\%submission_data,\%stats);
 }
 
 sub numerical_submission_is_correct {
     my ($award) = @_;
-    &Apache::lonnet::logthis('award = "'.$award.'"');
     if ($award =~ /^(APPROX_ANS|EXACT_ANS)$/) {
         return 1;
     } else {
@@ -535,7 +555,10 @@ sub numerical_determine_answers {
     my ($r,$resource,$partid,$respid,$students)=@_;
     my $c = $r->connection();
     #
-    # FIX ME: May need progress dialog updates
+    my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
+        ($r,'Student Answer Compilation Status',
+         'Student Answer Compilation Progress', scalar(@$students),
+         'inline',undef,'Statistics','stats_status');
     #
     # Read in the cache (if it exists) before we start timing things.
     &Apache::lonstathelpers::ensure_proper_cache($resource->{'symb'});
@@ -553,13 +576,16 @@ sub numerical_determine_answers {
                                                                 $sdom);
         # make the key
         my $key = $partid.'.'.$respid;
-        $correct->{$sname.':'.$sdom}->{'answer'} = 
-            $analysis->{$key.'.answer'}->[0];
-        $correct->{$sname.':'.$sdom}->{'unit'} = 
-            $analysis->{$key.'.unit'}->[0];
+        foreach my $item ('answer','unit','ans_high','ans_low') {
+            $correct->{$sname.':'.$sdom}->{$item} = 
+                $analysis->{$key.'.'.$item}->[0];
+        }
         $answers{$analysis->{$key.'.answer'}->[0]}++;
+        &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+                                                 &mt('last student'));
     }
     &Apache::lonstathelpers::write_analysis_cache();
+    &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
     return ($correct,\%answers);
 }
 
@@ -888,7 +914,6 @@ sub ensure_start_end_times {
 
 sub RR_concept_plot {
     my ($concepts,$foil_data,$title) = @_;
-    &Apache::lonnet::logthis('got to RR_concept_plot');
     #
     my %correct_by_concept;
     my %incorrect_by_concept;
@@ -936,7 +961,6 @@ sub RR_concept_plot {
 
 sub RR_create_percent_selected_plot {
     my ($concepts,$foils,$foil_data,$title) = @_;
-    &Apache::lonnet::logthis('got to RR_create_percent_selected_plot');
     #
     if ($foil_data->{'_count'} == 0) { return ''; };
     my %correct_selections;
@@ -1008,7 +1032,6 @@ sub RR_create_percent_selected_plot {
 sub RR_create_stacked_selection_plot {
     my ($foils,$foil_data,$title,$true_foils)=@_;
     #
-    &Apache::lonnet::logthis('got to RR_create_stacked_selection_plot');
     my @dataset; # array of array refs - multicolor rows $datasets[row]->[col]
     my @labels;
     my $count;