--- loncom/interface/statistics/lonproblemanalysis.pm	2003/09/29 21:13:23	1.24
+++ loncom/interface/statistics/lonproblemanalysis.pm	2003/10/06 20:51:20	1.25
@@ -1,6 +1,6 @@
 # The LearningOnline Network with CAPA
 #
-# $Id: lonproblemanalysis.pm,v 1.24 2003/09/29 21:13:23 matthew Exp $
+# $Id: lonproblemanalysis.pm,v 1.25 2003/10/06 20:51:20 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -24,16 +24,12 @@
 #
 # http://www.lon-capa.org/
 #
-# (Navigate problems for statistical reports
-# YEAR=2002
-# 5/12,7/26,9/7,11/22 Behrouz Minaei
-#
-###
 
 package Apache::lonproblemanalysis;
 
 use strict;
 use Apache::lonnet();
+use Apache::loncommon();
 use Apache::lonhtmlcommon();
 use Apache::loncoursedata();
 use Apache::lonstatistics;
@@ -42,48 +38,203 @@ use Apache::lonlocal;
 sub BuildProblemAnalysisPage {
     my ($r,$c)=@_;
     $r->print('<h2>'.&mt('Option Response Problem Analysis').'</h2>');
+    $r->print(&CreateInterface());
     if (exists($ENV{'form.problemchoice'})) {
-        # This is me getting around my own cleverness:
-        &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
-                                          undef);
+        $r->print('<hr />');
+        &Apache::lonstatistics::Gather_Full_Student_Data($r);
         #
-        my ($symb,$id) = &get_problem_symb(
+        my ($symb,$part,$resid) = &get_problem_symb(
                      &Apache::lonnet::unescape($ENV{'form.problemchoice'})
                                            );
         $r->print('<hr />');
         my $resource = &get_resource_from_symb($symb);
         if (defined($resource)) {
-            $r->print('<table bgcolor="ffffff"><tr><td>'.
-                      # Oh this is dumb!  Need to rewrite relative links
-                      # otherwise images (for example) will not show.
+            my %Data = &get_problem_data($resource->{'src'});
+            my $ORdata = $Data{$part.'.'.$resid};
+            ##
+            ## Render the problem for display
+            my $base;
+            ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
+            $base = "http://".$ENV{'SERVER_NAME'}.$base;
+            $r->print('</form>'.
+                      '<table bgcolor="ffffff"><tr><td>'.
+                      '<base href="'.$base.'" />'.
+#                      &Apache::loncommon::get_student_view
+#                      ($symb,$ENV{'user.name'},$ENV{'user.domain'},$ENV{'request.course.id'},'web').
                       &Apache::lonnet::ssi_body($resource->{'src'}).
-                      '</td></tr></table>');
+                      '</td></tr></table>'.
+           '<form name="Statistics" method="post" action="/adm/statistics">');
+            ##
+            ## Analyze the problem
+            my @Data = &Apache::loncoursedata::get_optionresponse_data
+                (undef,$symb,$resid);
+            my $analysis_html = &DoTriesAnalysis(\@Data,$ORdata);
+            $r->print($analysis_html);
         } else {
             $r->print('resource is undefined');
         }
         $r->print('<ol>');
-        $r->print("<li />render problem\n");
+        $r->print("<li /><strike>render problem</strike>\n");
+        $r->print("<li /><strike>Get student response data</strike>\n");
         $r->print("<li />image tag for plot\n");
         $r->print("<li />plot key\n");
         $r->print('</ol>');
-        $r->print("<pre>\nProblem choice = $symb $id\n</pre>\n");
         $r->print('<hr />');
-    }
-    $r->print('<input type="hidden" name="analysisfirstcall" value="no" />');
-    $r->print(&CreateInterface());
-    if (! exists($ENV{'form.analysisfirstcall'})) {
-        return;
+    } else {
+        $r->print('<h3>No Problem Selected</h3>');
     }
     # Okay, they asked for data, so make sure we get the latest data.
-    &Apache::lonnet::logthis('got here for some reason');
-#    &Apache::lonstatistics::Gather_Full_Student_Data($r);
     $r->print(&OptionResponseProblemSelector());
 }
 
+
+sub DoTriesAnalysis {
+    my ($Data,$ORdata) = @_;
+    my $mintries = 1;
+    my $maxtries = 3;
+    my %ResponseData = &analyze_option_data_by_tries($Data,
+                                                 $mintries,$maxtries);
+    my @Foils = sort(keys(%ResponseData));
+    my %Row_Label;
+    foreach my $foilid (@Foils) {
+        my $value = $ORdata->{'Foiltext'}->{$foilid};
+        &Apache::lonnet::logthis('row label '.$foilid.' = '.$value);
+        $Row_Label{$foilid} = $ORdata->{'Foiltext'}->{$foilid};
+    }
+    my @Rows;
+    $Rows[0] = ['<td>&nbsp;</td>'];
+    for (my $i=$mintries;$i<=$maxtries;$i++) {
+        push (@{$Rows[0]},
+              '<th colspan="3">'.&mt('Attempt').' '.$i.'</th>');
+    }
+    $Rows[1] = ['<th>'.&mt('Foil').'</th>'];
+    for (my $i=$mintries;$i<=$maxtries;$i++) {
+        push (@{$Rows[1]},('<th>'.&mt('Correct').'</th>',
+                           '<th>'.&mt('Incorrect').'</th>',
+                           '<th>'.&mt('Percent Correct').'</th>',
+                           ));
+    }
+    my @PlotData;
+    my @CumulativePlotData;
+    my $index = 1;
+    foreach my $foilid (@Foils) {
+        my @Data = ('<td>'.$index.' '.$Row_Label{$foilid}.'</td>');
+        for (my $i=$mintries;$i<=$maxtries;$i++) {
+            push(@Data,
+                 ('<td>'.$ResponseData{$foilid}->[$i]->{'correct'}.'</td>',
+                  '<td>'.$ResponseData{$foilid}->[$i]->{'incorrect'}.
+                  '</td>',
+                  '<td>'.
+                  sprintf("%4.2f",
+                          $ResponseData{$foilid}->[$i]->{'percent_corr'}).
+                  '</td>'));
+            #
+            # Gather the per-attempt data
+            push (@{$PlotData[$i]->{'good'}},
+                  $ResponseData{$foilid}->[$i]->{'percent_corr'});
+            push (@{$PlotData[$i]->{'bad'}},
+                  100-$ResponseData{$foilid}->[$i]->{'percent_corr'});
+        }
+        for (my $i=0;$i<=$maxtries;$i++) {
+            push (@{$CumulativePlotData[$i]->{'good'}},
+                  $CumulativePlotData[-1]->{'good'}+
+                  $ResponseData{$foilid}->[$i]->{'correct'});
+            push (@{$CumulativePlotData[$i]->{'bad'}},
+                  $CumulativePlotData[-1]->{'bad'}+
+                  $ResponseData{$foilid}->[$i]->{'incorrect'});
+        }
+        push(@Rows,\@Data);
+    } continue {
+        $index++;
+    }
+    my @Data = ('<td></td>');
+    for (my $i=$mintries;$i<=$maxtries;$i++) {
+        push(@Data,'<td colspan="3">'.&DrawGraph('Attempt '.$i,'Foil Number',
+                                     'Percent Correct',100,
+                                     $PlotData[$i]->{'good'},
+                                     $PlotData[$i]->{'bad'}).'</td>');
+    }
+    push (@Rows,\@Data);
+    my $table = '<table border="1" >'."\n";
+    for (my $i=0; $i <=$#Rows;$i++) {
+        $table .= '<tr>'.join('',@{$Rows[$i]})."</tr>\n";
+    }
+    $table .= '</table>';
+    return ($table);
+}
+
+sub analyze_option_data_by_tries {
+    my ($data,$mintries,$maxtries) = @_;
+    my %Trydata;
+    $mintries = 1         if (! defined($mintries) || $mintries < 1);
+    $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
+    foreach my $row (@$data) {
+        my ($grading,$submission,$time,$tries) = @$row;
+        my @Foilgrades = split('&',$grading);
+        my @Foilsubs   = split('&',$submission);
+        for (my $numtries = 1; $numtries <= $maxtries; $numtries++) {
+            if ($tries == $numtries) {
+                foreach my $foilgrade (@Foilgrades) {
+                    my ($foilid,$correct) = split('=',$foilgrade);
+                    if ($correct) {
+                        $Trydata{$foilid}->[$numtries]->{'correct'}++;
+                    } else {
+                        $Trydata{$foilid}->[$numtries]->{'incorrect'}++;
+                    }                        
+                }
+            }
+        }
+    }
+    foreach my $foilid (keys(%Trydata)) {
+        foreach my $tryhash (@{$Trydata{$foilid}}) {
+            next if ((! exists($tryhash->{'correct'}) && 
+                      ! exists($tryhash->{'incorrect'})) ||
+                     ($tryhash->{'correct'} < 1 &&
+                      $tryhash->{'incorrect'} < 1));
+            $tryhash->{'percent_corr'} = 100 *
+                ($tryhash->{'correct'} /
+                         ($tryhash->{'correct'} + $tryhash->{'incorrect'})
+                 );
+        }
+    }
+    return %Trydata;
+}
+
+sub DrawGraph {
+    my ($title,$xlabel,$ylabel,$MaxY,$values1,$values2)=@_;
+    $title  = '' if (! defined($title));
+    $xlabel = '' if (! defined($xlabel));
+    $ylabel = '' if (! defined($ylabel));
+    $title = &Apache::lonnet::escape($title);
+    $xlabel = &Apache::lonnet::escape($xlabel);
+    $ylabel = &Apache::lonnet::escape($ylabel);
+    #
+    my $sendValues1 = join(',', @$values1);
+    my $sendValues2;
+    if (defined($values2)) {
+        $sendValues2 = join(',', @$values2);
+    }
+            
+    my $sendCount = scalar(@$values1);
+    $MaxY =1 if ($MaxY < 1);
+    if ( int($MaxY) < $MaxY ) {
+        $MaxY++;
+        $MaxY = int($MaxY);
+    }
+    my @GData = ($title,$xlabel,$ylabel,$MaxY,$sendCount,$sendValues1);
+    if (defined($sendValues2)) {
+        push (@GData,$sendValues2);
+    }
+    return '<IMG src="/cgi-bin/graph.png?'.
+        (join('&', @GData)).'" border="1" />';
+}
+
+
+
 sub get_problem_symb {
     my $problemstring = shift();
-    my ($symb,$id) = ($problemstring=~ /^(.*):([^:]*)$/);
-    return ($symb,$id);
+    my ($symb,$partid,$resid) = ($problemstring=~ /^(.*):([^:]*):([^:]*)$/);
+    return ($symb,$partid,$resid);
 }
 
 sub CreateInterface {
@@ -140,7 +291,7 @@ sub OptionResponseProblemSelector {
                     my $respid = $partdata->{'ResponseIds'}->[$i];
                     my $resptype = $partdata->{'ResponseTypes'}->[$i];
                     if ($resptype eq 'option') {
-                        my $value = &Apache::lonnet::escape($res->{'symb'}.':'.$respid);
+                        my $value = &Apache::lonnet::escape($res->{'symb'}.':'.$part.':'.$respid);
                         my $checked = '';
                         if ($ENV{'form.problemchoice'} eq $value) {
                             $checked = 'checked ';
@@ -168,10 +319,8 @@ sub OptionResponseProblemSelector {
 
 sub get_resource_from_symb {
     my ($symb) = @_;
-    &Apache::lonnet::logthis('target symb = :'.$symb.':');
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
         foreach my $res (@{$seq->{'contents'}}) {
-            &Apache::lonnet::logthis('symb = :'.$res->{'symb'}.':');
             if ($res->{'symb'} eq $symb) {
                 return $res;
             }
@@ -180,46 +329,74 @@ sub get_resource_from_symb {
     return undef;
 }
 
-=pod
-
-sub InitAnalysis {
-    my ($resource,$sname,$sdom)=@_;
-    my $symb = $resource->
-    my $URI = $hash{'src_'.$rid};
-
-    my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze',
-                                  'grade_username' => $sname,
-                                  'grade_domain' => $sdom,
-                                  'grade_courseid' => $cid,
-                                  'grade_symb' => $symb));
-#    my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze'));
-
+sub get_problem_data {
+    my ($url) = @_;
+#    my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze',
+#                                  'grade_username' => $sname,
+#                                  'grade_domain' => $sdom,
+#                                  'grade_courseid' => $cid,
+#                                  'grade_symb' => $symb));
+    my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
-    %Answer=();
+    my %Answer;
     %Answer=&Apache::lonnet::str2hash($Answ);
-
-    my $parts='';
-    foreach my $elm (@{$Answer{"parts"}}) {
-        $parts.="$elm,";
-    }
-    chop($parts);
-    my $conc='';
-    foreach my $elm (@{$Answer{"$parts.concepts"}}) {
-        $conc.="$elm@";
-    }
-    chop($conc);
-
-    @Concepts=split(/\@/,$conc);
-    foreach my $concept (@{$Answer{"$parts.concepts"}}) {
-        foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
-            $foil_to_concept{$foil} = $concept;
-            #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
+#    &Apache::lonnet::logthis('keys of %Answer = '.join(', ',(keys(%Answer))));
+#    &Apache::lonnet::logthis('$Answer{parts} = '.
+#                             join(', ',@{$Answer{'parts'}}));
+    my %Partdata;
+    foreach my $part (@{$Answer{'parts'}}) {
+        while (my($key,$value) = each(%Answer)) {
+            next if ($key !~ /^$part/);
+            $key =~ s/^$part\.//;
+            if (ref($value) eq 'ARRAY') {
+                if ($key eq 'options') {
+                    $Partdata{$part}->{'Options'}=$value;
+                } elsif ($key eq 'concepts') {
+                    $Partdata{$part}->{'Concepts'}=$value;
+                } elsif ($key =~ /^concept\.(.*)$/) {
+                    my $concept = $1;
+                    foreach my $foil (@$value) {
+                        $Partdata{$part}->{$foil}->{'Concept'}=$concept;
+                    }
+                }
+                &Apache::lonnet::logthis($part.' '.$key.' (array) = '.
+                                         join(', ',@$value));
+            } else {
+                $value =~ s/^\s*//g;
+                $value =~ s/\s*$//g;
+                if ($key=~ /^foil\.text\.(.*)$/) {
+                    my $foil = $1;
+                    $Partdata{$part}->{'Foiltext'}->{$foil}=$value;
+                } elsif ($key =~ /^foil\.value\.(.*)$/) {
+                    my $foil = $1;
+                    $Partdata{$part}->{'FoilValues'}->{$foil}=$value;
+                }
+                &Apache::lonnet::logthis($part.' '.$key.' = '.$value);
+            }
         }
     }
-    return $symb;
-}
 
-=cut
+#    my $parts='';
+#    foreach my $elm (@{$Answer{"parts"}}) {
+#        $parts.="$elm,";
+#    }
+#    chop($parts);
+#    my $conc='';
+#    foreach my $elm (@{$Answer{"$parts.concepts"}}) {
+#        $conc.="$elm@";
+#    }
+#    chop($conc);
+#
+#    @Concepts=split(/\@/,$conc);
+#    foreach my $concept (@{$Answer{"$parts.concepts"}}) {
+#        foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
+#            $foil_to_concept{$foil} = $concept;
+#            #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
+#        }
+#    }
+#    return $symb;
+    return %Partdata;
+}
 
 1;