--- loncom/interface/statistics/lonstathelpers.pm	2004/01/19 21:29:46	1.1
+++ loncom/interface/statistics/lonstathelpers.pm	2004/01/20 15:51:06	1.2
@@ -1,6 +1,6 @@
 # The LearningOnline Network with CAPA
 #
-# $Id: lonstathelpers.pm,v 1.1 2004/01/19 21:29:46 matthew Exp $
+# $Id: lonstathelpers.pm,v 1.2 2004/01/20 15:51:06 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -94,6 +94,267 @@ sub render_resource {
         '</td></tr></table>';
 }
 
+####################################################
+####################################################
+
+=pod
+
+=item &ProblemSelector($AcceptedResponseTypes)
+
+Input: scalar containing regular expression which matches response
+types to show.  '.' will yield all, '(option|radiobutton)' will match
+all option response and radiobutton problems.
+
+Returns: A string containing html for a table which lists the sequences
+and their contents.  A radiobutton is provided for each problem.
+
+=cut
+
+####################################################
+####################################################
+sub ProblemSelector {
+    my ($AcceptedResponseTypes) = @_;
+    my $Str;
+    $Str = "\n<table>\n";
+    foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+        next if ($seq->{'num_assess'}<1);
+        my $seq_str = '';
+        foreach my $res (@{$seq->{'contents'}}) {
+            next if ($res->{'type'} ne 'assessment');
+            foreach my $part (@{$res->{'parts'}}) {
+                my $partdata = $res->{'partdata'}->{$part};
+                if ((! exists($partdata->{'option'}) || 
+                     $partdata->{'option'} == 0      ) &&
+                    (! exists($partdata->{'radiobutton'}) ||
+                     $partdata->{'radiobutton'} == 0)) {
+                    next;
+                }
+                for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
+                    my $respid = $partdata->{'ResponseIds'}->[$i];
+                    my $resptype = $partdata->{'ResponseTypes'}->[$i];
+                    if ($resptype =~ m/$AcceptedResponseTypes/) {
+                        my $value = &make_target_id({symb=>$res->{'symb'},
+                                                     part=>$part,
+                                                     respid=>$respid,
+                                                     resptype=>$resptype});
+                        my $checked = '';
+                        if ($ENV{'form.problemchoice'} eq $value) {
+                            $checked = 'checked ';
+                        }
+                        my $title = $res->{'title'};
+                        if (! defined($title) || $title eq '') {
+                            ($title) = ($res->{'src'} =~ m:/([^/]*)$:);
+                        }
+                        $seq_str .= '<tr><td>'.
+  '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
+  '</td><td>'.          
+  $resptype.'</td><td>'.
+  '<a href="'.$res->{'src'}.'">'.$title.'</a> ';
+#  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';
+                        if ($partdata->{'option'} > 1) {
+                            $seq_str .= &mt('response').' '.$respid;
+                        }
+                        $seq_str .= "</td></tr>\n";
+                    }
+                }
+            }
+        }
+        if ($seq_str ne '') {
+            $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'.
+                "</tr>\n".$seq_str;
+        }
+    }
+    $Str .= "</table>\n";
+    return $Str;
+}
+
+####################################################
+####################################################
+
+=pod
+
+=item &make_target_id($target)
+
+Inputs: Hash ref with the following entries:
+    $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
+    $target->{'resptype'}.
+
+Returns: A string, suitable for a form parameter, which uniquely identifies
+the problem, part, and response to do statistical analysis on.
+
+Used by Apache::lonstathelpers::ProblemSelector().
+
+=cut
+
+####################################################
+####################################################
+sub make_target_id {
+    my ($target) = @_;
+    my $id = &Apache::lonnet::escape($target->{'symb'}).':'.
+             &Apache::lonnet::escape($target->{'part'}).':'.
+             &Apache::lonnet::escape($target->{'respid'}).':'.
+             &Apache::lonnet::escape($target->{'resptype'});
+    return $id;
+}
+
+####################################################
+####################################################
+
+=pod
+
+=item &get_target_from_id($id)
+
+Inputs: $id, a scalar string from Apache::lonstathelpers::make_target_id().
+
+Returns: A hash reference, $target, containing the following keys:
+    $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
+    $target->{'resptype'}.
+
+=cut
+
+####################################################
+####################################################
+sub get_target_from_id {
+    my ($id) = @_;
+    my ($symb,$part,$respid,$resptype) = split(':',$id);
+    return ({ symb    =>&Apache::lonnet::unescape($symb),
+             part     =>&Apache::lonnet::unescape($part),
+             respid   =>&Apache::lonnet::unescape($respid),
+             resptype =>&Apache::lonnet::unescape($resptype)});
+}
+
+####################################################
+####################################################
+
+=pod
+
+=item &get_prev_curr_next($target)
+
+Determine the problem parts or responses preceeding and following the
+current resource.
+
+Inputs: $target (see &Apache::lonstathelpers::get_target_from_id())
+  $AcceptableResponseTypes, regular expression matching acceptable
+                            response types,
+  $granularity, either 'part' or 'response'
+
+Returns: three hash references, $prev, $curr, $next, which refer to the
+preceeding, current, or following problem parts or responses, depending
+on the value of $granularity.  Values of undef indicate there is no
+previous or next part/response.  A value of undef for all three indicates
+there was no match found to the current part/resource.
+
+The hash references contain the following keys:
+    symb, part, resource
+
+If $granularity eq 'response', the following ADDITIONAL keys will be present:
+    respid, resptype
+
+=cut
+
+####################################################
+####################################################
+sub get_prev_curr_next {
+    my ($target,$AcceptableResponseTypes,$granularity) = @_;
+    #
+    # Build an array with the data we need to search through
+    my @Resource;
+    foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+        foreach my $res (@{$seq->{'contents'}}) {
+            next if ($res->{'type'} ne 'assessment');
+            foreach my $part (@{$res->{'parts'}}) {
+                my $partdata = $res->{'partdata'}->{$part};
+                if ($granularity eq 'part') {
+                    push (@Resource,
+                          { symb     => $res->{symb},
+                            part     => $part,
+                            resource => $res,
+                        } );
+                } elsif ($granularity eq 'response') {
+                    for (my $i=0;
+                         $i<scalar(@{$partdata->{'ResponseTypes'}});
+                         $i++){
+                        my $respid = $partdata->{'ResponseIds'}->[$i];
+                        my $resptype = $partdata->{'ResponseTypes'}->[$i];
+                        next if ($resptype !~ m/$AcceptableResponseTypes/);
+                        push (@Resource,
+                              { symb     => $res->{symb},
+                                part     => $part,
+                                respid   => $partdata->{'ResponseIds'}->[$i],
+                                resource => $res,
+                                resptype => $resptype
+                                } );
+                    }
+                }
+            }
+        }
+    }
+    #
+    # Get the index of the current situation
+    my $curr_idx;
+    for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {
+        my $curr_item = $Resource[$curr_idx];
+        if ($granularity eq 'part') {
+            if ($curr_item->{'symb'} eq $target->{'symb'} &&
+                $curr_item->{'part'} eq $target->{'part'}) {
+                last;
+            }
+        } elsif ($granularity eq 'response') {
+            if ($curr_item->{'symb'} eq $target->{'symb'} &&
+                $curr_item->{'part'} eq $target->{'part'} &&
+                $curr_item->{'respid'} eq $target->{'respid'} &&
+                $curr_item->{'resptype'} eq $target->{'resptype'}) {
+                last;
+            }
+        }
+    }
+    my $curr_item = $Resource[$curr_idx];
+    if ($granularity eq 'part') {
+        if ($curr_item->{'symb'}     ne $target->{'symb'} ||
+            $curr_item->{'part'}     ne $target->{'part'}) {
+            # bogus symb - return nothing
+            return (undef,undef,undef);
+        }
+    } elsif ($granularity eq 'response') {
+        if ($curr_item->{'symb'}     ne $target->{'symb'} ||
+            $curr_item->{'part'}     ne $target->{'part'} ||
+            $curr_item->{'respid'}   ne $target->{'respid'} ||
+            $curr_item->{'resptype'} ne $target->{'resptype'}){
+            # bogus symb - return nothing
+            return (undef,undef,undef);
+        }
+    }
+    #
+    # Now just pick up the data we need
+    my ($prev,$curr,$next);
+    if ($curr_idx == 0) {
+        $prev = undef;
+        $curr = $Resource[$curr_idx  ];
+        $next = $Resource[$curr_idx+1];
+    } elsif ($curr_idx == $#Resource) {
+        $prev = $Resource[$curr_idx-1];
+        $curr = $Resource[$curr_idx  ];
+        $next = undef;
+    } else {
+        $prev = $Resource[$curr_idx-1];
+        $curr = $Resource[$curr_idx  ];
+        $next = $Resource[$curr_idx+1];
+    }
+    return ($prev,$curr,$next);
+}
+
+####################################################
+####################################################
+
+=pod
+
+=back
+
+=cut
+
+####################################################
+####################################################
+
 1;
 
 __END__