--- loncom/interface/statistics/lonproblemanalysis.pm	2004/02/10 19:49:54	1.65
+++ loncom/interface/statistics/lonproblemanalysis.pm	2004/02/16 19:59:49	1.67
@@ -1,6 +1,6 @@
 # The LearningOnline Network with CAPA
 #
-# $Id: lonproblemanalysis.pm,v 1.65 2004/02/10 19:49:54 matthew Exp $
+# $Id: lonproblemanalysis.pm,v 1.67 2004/02/16 19:59:49 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -99,6 +99,7 @@ sub BuildProblemAnalysisPage {
     }
     $r->rflush();
     #
+    my $problem_types = '(option|radiobutton|numerical)';
     if (exists($ENV{'form.problemchoice'}) && 
         ! exists($ENV{'form.SelectAnother'})) {
         foreach my $button (@SubmitButtons) {
@@ -120,8 +121,8 @@ sub BuildProblemAnalysisPage {
         #
         my ($prev,$curr,$next) = 
             &Apache::lonstathelpers::get_prev_curr_next($current_problem,
-                                                     '(option|radiobutton)',
-                                                     'response',
+                                                        $problem_types,
+                                                        'response',
                                                         );
         if (exists($ENV{'form.PrevProblemAnalysis'}) && defined($prev)) {
             $current_problem = $prev;
@@ -157,6 +158,9 @@ sub BuildProblemAnalysisPage {
                 &RadioResponseAnalysis($r,$current_problem,
                                        $ProblemData,
                                        \@Students);
+            } elsif ($current_problem->{'resptype'} eq 'numerical') {
+                &NumericalResponseAnalysis($r,$current_problem,
+                                           $ProblemData,\@Students);
             } else {
                 $r->print('<h2>This analysis is not supported</h2>');
             }
@@ -168,10 +172,71 @@ sub BuildProblemAnalysisPage {
         $r->print('&nbsp;'x5);
         $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
         $r->print(&Apache::lonstathelpers::ProblemSelector
-                  ('(option|radiobutton)'));
+                  ($problem_types));
     }
 }
 
+#########################################################
+#########################################################
+##
+##      Numerical Response Routines
+##
+#########################################################
+#########################################################
+sub NumericalResponseAnalysis {
+    my ($r,$problem,$ProblemData,$Students) = @_;
+    my ($resource,$respid) = ($problem->{'resource'},
+                              $problem->{'respid'});
+    my $analysis_html;
+    my $PerformanceData = 
+        &Apache::loncoursedata::get_response_data
+        ($Students,$resource->{'symb'},$respid);
+    if (! defined($PerformanceData) || 
+        ref($PerformanceData) ne 'ARRAY' ) {
+        $analysis_html = '<h2>'.
+            &mt('There is no submission data for this resource').
+            '</h2>';
+        $r->print($analysis_html);
+        return;
+    }
+    my $Answers = &GetStudentAnswers($r,$problem,$Students);
+    
+    $r->print('<h2>This analysis is not yet supported</h2>');
+}
+
+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 = analyze_problem_as_student($resource,
+                                                $sname,$sdom,
+                                                $partid,$respid);
+        $r->print('<tr>'.
+                  '<td>'.$sname.'</td>'.
+                  '<td>'.$sdom.'</td>'.
+                  '<td>'.$answer.'</td>'.
+                  '</tr>'."\n");
+        &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+                                                 &mt('last student'));
+        $Answers{$sname.':'.$sdom}=$answer;
+    }
+    $r->print("</table>\n");
+    $r->rflush();
+    &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+    # close progress window
+    return \%Answers;
+}
 
 #########################################################
 #########################################################
@@ -183,7 +248,7 @@ sub BuildProblemAnalysisPage {
 sub RadioResponseAnalysis {
     my ($r,$problem,$ProblemData,$Students) = @_;
     my ($resource,$respid) = ($problem->{'resource'},
-                                    $problem->{'respid'});
+                              $problem->{'respid'});
     my $analysis_html;
     my $PerformanceData = 
         &Apache::loncoursedata::get_response_data
@@ -1268,15 +1333,15 @@ sub build_foil_index {
         my $a1 = lc($a); 
         my $b1 = lc($b);
         if (exists($Numbers{$a1})) {
-            $a = $Numbers{$a1};
+            $a1 = $Numbers{$a1};
         }
         if (exists($Numbers{$b1})) {
-            $b = $Numbers{$b1};
+            $b1 = $Numbers{$b1};
         }
-        if (($a =~/^\d+$/) && ($b =~/^\d+$/)) {
-            return $a <=> $b;
+        if (($a1 =~/^\d+$/) && ($b1 =~/^\d+$/)) {
+            return $a1 <=> $b1;
         } else {
-            return $a cmp $b;
+            return $a1 cmp $b1;
         }
     };
     my @Concepts;
@@ -1552,6 +1617,27 @@ sub Process_OR_Row {
     return %RowData;
 }
 
+
+sub analyze_problem_as_student {
+    my ($resource,$sname,$sdom,$partid,$respid) = @_;
+    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 $key = $partid.'.'.$respid.'.answer';
+    my $student_answer = $Answer{$key}->[0];
+    if (! defined($student_answer)) {
+        $student_answer = $Answer{$key}->[1];
+    }
+    return ($student_answer);
+}
+
 ##
 ## get problem data and put it into a useful data structure.
 ## note: we must force each foil and option to not begin or end with
@@ -1566,6 +1652,17 @@ sub get_problem_data {
     my %Partdata;
     foreach my $part (@{$Answer{'parts'}}) {
         while (my($key,$value) = each(%Answer)) {
+            #
+            # Logging code:
+            if (0) {
+                &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') {
@@ -1579,6 +1676,8 @@ sub get_problem_data {
                         $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
                                                                       $concept;
                     }
+                } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high)$/) {
+                    $Partdata{$part}->{$key}=$value;
                 }
             } else {
                 if ($key=~ /^foil\.text\.(.*)$/) {
@@ -1599,11 +1698,3 @@ sub get_problem_data {
 1;
 
 __END__
-
-#####
-# partdata{part}->{_Foils}->{foilid}->{'name'}     = $
-#                                   ->{'text'}     = $
-#                                   ->{'value'}    = $
-#                                   ->{'_Concept'} = $
-# partdata{part}->{_Options}  = @
-# partdata{part}->{_Concepts} = @