--- loncom/interface/statistics/lonproblemanalysis.pm	2004/03/11 20:11:18	1.77
+++ loncom/interface/statistics/lonproblemanalysis.pm	2004/04/01 15:32:06	1.84
@@ -1,6 +1,6 @@
 # The LearningOnline Network with CAPA
 #
-# $Id: lonproblemanalysis.pm,v 1.77 2004/03/11 20:11:18 matthew Exp $
+# $Id: lonproblemanalysis.pm,v 1.84 2004/04/01 15:32:06 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -99,7 +99,7 @@ sub BuildProblemAnalysisPage {
     }
     $r->rflush();
     #
-    my $problem_types = '(option|radiobutton)';
+    my $problem_types = '(option|radiobutton|numerical)';
     if (exists($ENV{'form.problemchoice'}) && 
         ! exists($ENV{'form.SelectAnother'})) {
         foreach my $button (@SubmitButtons) {
@@ -160,13 +160,17 @@ sub BuildProblemAnalysisPage {
                                        $ProblemData,
                                        \@Students);
             } elsif ($current_problem->{'resptype'} eq 'numerical') {
-#                if (exists($ENV{'form.ExcelOutput'})) {
-                    &Apache::lonstudentsubmissions::prepare_excel_output
-                        ($r,$current_problem,$ProblemData,\@Students);
-#                } else {
-#                    &NumericalResponseAnalysis($r,$current_problem,
-#                                               $ProblemData,\@Students);
-#                }
+                ## 
+                ## analyze all responses of a problem at once
+                my $res = $current_problem->{'resource'};
+                foreach my $partid (@{$res->{'parts'}}) {
+                    $current_problem->{'part'} = $partid;
+                    foreach my $respid (@{$res->{'partdata'}->{$partid}->{'ResponseIds'}}) {
+                        $current_problem->{'respid'}=$respid;
+                        &NumericalResponseAnalysis($r,$current_problem,
+                                                   $ProblemData,\@Students);
+                    }
+                }
             } else {
                 $r->print('<h2>This analysis is not supported</h2>');
             }
@@ -192,13 +196,30 @@ sub BuildProblemAnalysisPage {
 #########################################################
 sub NumericalResponseAnalysis {
     my ($r,$problem,$ProblemData,$Students) = @_;
-    $r->print('<h2>This analysis is not yet supported</h2>');
-    my ($resource,$respid) = ($problem->{'resource'},
-                              $problem->{'respid'});
+    my $c = $r->connection();
+    my ($resource,$partid,$respid) = ($problem->{'resource'},
+                                      $problem->{'part'},
+                                      $problem->{'respid'});
+    #
+    if (scalar(@{$resource->{'parts'}})>1) {
+        if (@{$resource->{'partdata'}->{$partid}->{'ResponseIds'}}>1) {
+            $r->print('<h3>'.
+                      &mt('Part [_1], response [_2].',$partid,$respid).
+                      '</h3>');
+        } else { 
+            $r->print('<h3>'.
+                      &mt('Part [_1]',$partid,$respid).
+                      '</h3>');
+        }
+    } elsif (@{$resource->{'partdata'}->{$partid}->{'ResponseIds'}}>1) {
+        $r->print('<h3>'.&mt('Response [_1]',$respid).'</h3>');
+    }
+    #
     my $analysis_html;
-    my $PerformanceData = 
-        &Apache::loncoursedata::get_response_data
-        ($Students,$resource->{'symb'},$respid);
+    my $PerformanceData = &Apache::loncoursedata::get_response_data
+        (\@Apache::lonstatistics::SelectedSections,
+         $Apache::lonstatistics::enrollment_status,
+         $resource->{'symb'},$respid);
     if (! defined($PerformanceData) || 
         ref($PerformanceData) ne 'ARRAY' ) {
         $analysis_html = '<h2>'.
@@ -207,66 +228,124 @@ sub NumericalResponseAnalysis {
         $r->print($analysis_html);
         return;
     }
-    my ($max,$min) = &GetStudentAnswers($r,$problem,$Students);
-    $r->print('Maximum = '.$max.' Minimum = '.$min);
-    my $max_students = 0;
+    #
+    # This next call causes all the waiting around that people complain about
+    my ($max,$min) = &Apache::lonstathelpers::GetStudentAnswers($r,$problem,
+                                                                $Students);
+    return if ($c->aborted());
+    #
+    # Collate the data
     my %Data;
     foreach my $student (@$Students) {
         my $answer = $student->{'answer'};
         $Data{$answer}++;
-        if ($max_students < $Data{$answer}) {
-            $max_students = $Data{$answer};
-        }
-    }
-    foreach (5,10,20,25,50,75,100,150,200,250,500,1000,1500,2000,2500,5000) {
-        if ($max_students < $_) {
-            $max_students = $_;
-            last;
-        }
     }
     my @Labels = sort {$a <=> $b } keys(%Data);
-    $r->print('number of labels = '.scalar(@Labels));
     my @PlotData = @Data{@Labels};
-    $r->print('number of PlotData = '.scalar(@PlotData));
-    my $graph = 
-        &Apache::loncommon::DrawXYGraph('Correct Answer Distribution',
-                                        'Correct Answer',
-                                        'Number of students',
-                                        $max_students,
-                                        undef,
-                                        \@Labels,
-                                        [\@PlotData],
-                                        (xskip=>10));
-    $r->print($graph);
+    #
+    my $width  = 500; 
+    my $height = 100;
+    my $plot = &one_dimensional_plot($r,500,100,scalar(@$Students),
+                                     \@Labels,\@PlotData);
+    $r->print($plot);
     return;
 }
 
-sub GetStudentAnswers {
-    my ($r,$problem,$Students) = @_;
-    my %Answers;
-    my ($resource,$partid,$respid) = ($problem->{'resource'},
-                                      $problem->{'part'},
-                                      $problem->{'respid'});
-    # Open progress window
-    my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
-        ($r,'Student Answer Compilation Status',
-         'Student Answer Compilation Progress', scalar(@$Students));
-    $r->print("<table>\n");
-    $r->rflush();
-    foreach my $student (@$Students) {
-        my $sname = $student->{'username'};
-        my $sdom = $student->{'domain'};
-        my $answer = &Apache::lonstathelpers::analyze_problem_as_student
-            ($resource,$sname,$sdom,$partid,$respid);
-        &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
-                                                 &mt('last student'));
-        $student->{'answer'} = $answer;
+sub one_dimensional_plot {
+    my ($r,$width,$height,$N,$Labels,$Data)=@_;
+    #
+    # Compute data -> image scaling factors
+    my $min = $Labels->[0];
+    my $max = $Labels->[-1];
+    if ($max == $min) {
+        $max =$min+1;
+    }
+    my $h_scale = ($width-10)/($max-$min);
+    #
+    my $max_y = 0;
+    foreach (@$Data) {
+        $max_y = $_ if ($max_y < $_);
+    }
+    my $ticscale = 5;
+    if ($max_y * $ticscale > $height/2) {
+        $ticscale = int($height/2/$max_y);
+        $ticscale = 1 if ($ticscale < 1);
     }
-    $r->print("</table>\n");
-    $r->rflush();
-    # close progress window
-    &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
-    return;
+    #
+    # Create the plot
+    my $plot = 
+        qq{<drawimage width="$width" height="$height" bgcolor="transparent" >};
+    for (my $idx=0;$idx<scalar(@$Labels);$idx++) {
+        my $xloc = 5+$h_scale*($Labels->[$idx] - $min);
+        my $top    = $height/2-$Data->[$idx]*$ticscale;
+        my $bottom = $height/2+$Data->[$idx]*$ticscale;
+        $plot .= 
+            &line($xloc,$top,$xloc,$bottom,'888888',1);
+    }
+    #
+    # Put the scale on last to ensure it is on top of the data.
+    if ($min < 0 && $max > 0) {
+        my $circle_x = 5+$h_scale*abs($min);  # '0' in data coordinates
+        my $r = 4;
+        $plot .= &line(5,$height/2,$circle_x-$r,$height/2,'000000',1);
+        $plot .= &circle($circle_x,$height/2,$r+1,'000000');
+        $plot .= &line($circle_x+$r,$height/2,$width-5,$height/2,'000000',1);
+    } else {
+        $plot .= &line(5,$height/2,$width-5,$height/2,'000000',1);
+    }
+    $plot .= '</drawimage>';
+    my $plotresult =  &Apache::lonxml::xmlparse($r,'web',$plot);
+    
+    my $title = 'Distribution of correct answers';
+    my $result = '<table>'.
+        '<tr><td colspan="3" align="center">'.
+        '<font size="+2">'.$title.' (N='.$N.')'.
+        '</font>'.
+        '</td></tr>'.
+        '<tr>'.
+        '<td valign="center">'.$min.'</td>'.
+        '<td>'.$plotresult.'</td>'.
+        '<td valign="center">'.$max.'</td>'.
+        '</tr>'.
+        '<tr><td colspan="3" align="center">'.
+        'Maximum Number of Coinciding Values: '.$max_y.
+        '</td></tr>'.
+        '</table>';
+    return $result;
+}
+
+##
+## Helper subroutines for <drawimage>.  
+## These should probably go somewhere more suitable soon.
+sub line {
+    my ($x1,$y1,$x2,$y2,$color,$thickness) = @_;
+    return qq{<line x1="$x1" y1="$y1" x2="$x2" y2="$y2" color="$color" thickness="$thickness" />$/};
+}
+
+sub text {
+    my ($x,$y,$color,$text,$font,$direction) = @_;
+    if (! defined($font) || $font !~ /^(tiny|small|medium|large|giant)$/) {
+        $font = 'medium';
+    }
+    if (! defined($direction) || $direction ne 'vertical') {
+        $direction = '';
+    }
+    return qq{<text x="$x" y="$y" color="$color" font="$font" direction="$direction" >$text</text>};
+}
+
+sub rectangle {
+    my ($x1,$y1,$x2,$y2,$color,$thickness,$filled) = @_;
+    return qq{<rectangle x1="$x1" y1="$y1" x2="$x2" y2="$y2" color="$color" thickness="$thickness" filled="$filled" />};
+}
+
+sub arc {
+    my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)=@_;
+    return qq{<arc x="$x" y="$y" width="$width" height="$height" start="$start" end="$end" color="$color" thickness="$thickness" filled="$filled" />};
+}
+
+sub circle {
+    my ($x,$y,$radius,$color,$thickness,$filled)=@_;
+    return &arc($x,$y,$radius,$radius,0,360,$color,$thickness,$filled);
 }
 
 sub build_student_data_worksheet {
@@ -308,9 +387,10 @@ sub RadioResponseAnalysis {
     my ($resource,$respid) = ($problem->{'resource'},
                               $problem->{'respid'});
     my $analysis_html;
-    my $PerformanceData = 
-        &Apache::loncoursedata::get_response_data
-        ($Students,$resource->{'symb'},$respid);
+    my $PerformanceData = &Apache::loncoursedata::get_response_data
+        (\@Apache::lonstatistics::SelectedSections,
+         $Apache::lonstatistics::enrollment_status,
+         $resource->{'symb'},$respid);
     if (! defined($PerformanceData) || 
         ref($PerformanceData) ne 'ARRAY' ) {
         $analysis_html = '<h2>'.
@@ -493,9 +573,10 @@ sub OptionResponseAnalysis {
     my ($resource,$respid) = ($problem->{'resource'},
                               $problem->{'respid'});
     # Note: part data is not needed.
-    my $PerformanceData = 
-        &Apache::loncoursedata::get_response_data
-        ($Students,$resource->{'symb'},$respid);
+    my $PerformanceData = &Apache::loncoursedata::get_response_data
+        (\@Apache::lonstatistics::SelectedSections,
+         $Apache::lonstatistics::enrollment_status,
+         $resource->{'symb'},$respid);
     if (! defined($PerformanceData) || 
         ref($PerformanceData) ne 'ARRAY' ) {
         $r->print('<h2>'.
@@ -541,7 +622,8 @@ sub OR_tries_analysis {
     my $mintries = 1;
     my $maxtries = $ENV{'form.NumPlots'};
     my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
-    if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) {
+    if (! defined($Concepts) || 
+        ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils'))) {
         $table = '<h3>'.
             &mt('Not enough data for concept analysis.  '.
                 'Performing Foil Analysis').
@@ -1238,18 +1320,18 @@ sub build_foil_index {
         if (@Concepts > 1) {
             $table .= '<tr>'.
                 '<td>'.$conceptindex.'</td>'.
-                '<td>'.&HTML::Entities::encode($concept->{'name'}).'</td>'.
+                '<td>'.&HTML::Entities::encode($concept->{'name'},'<>&"').'</td>'.
                 '<td>'.$foilindex++.'</td>'.
-                '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'}).'</td>'.
+                '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').'</td>'.
                 '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
-                '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'}).'</td>'.
+                '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').'</td>'.
                 "</tr>\n";
         } else {
             $table .= '<tr>'.
                 '<td>'.$foilindex++.'</td>'.
-                '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'}).'</td>'.
+                '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'},'<>&"').'</td>'.
                 '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
-                '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'}).'</td>'.
+                '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'},'<>&"').'</td>'.
                 "</tr>\n";
         }
         foreach my $foilid (@FoilsInConcept) {
@@ -1258,16 +1340,16 @@ sub build_foil_index {
                     '<td></td>'.
                     '<td></td>'.
                     '<td>'.$foilindex.'</td>'.
-                    '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'}).'</td>'.
+                    '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').'</td>'.
                     '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
-                    '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'}).'</td>'.
+                    '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'},'<>&"').'</td>'.
                     "</tr>\n";
             } else {
                 $table .= '<tr>'.
                     '<td>'.$foilindex.'</td>'.
-                    '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'}).'</td>'.
+                    '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'},'<>&"').'</td>'.
                     '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
-                    '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'}).'</td>'.
+                    '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'},'<>&"').'</td>'.
                     "</tr>\n";
             }                
         } continue {
@@ -1292,7 +1374,7 @@ sub build_option_index {
               '<tr>'.
               '<td bgcolor="'.$plotcolors->[$optionindex++].'">'.
               ('&nbsp;'x4).'</td>'.
-              '<td>'.&HTML::Entities::encode($option).'</td>'.
+              '<td>'.&HTML::Entities::encode($option,'<>&"').'</td>'.
               "</tr>\n");
     }
     shift(@Rows); # Throw away 'correct option chosen' color