[BACK]Return to lonstathelpers.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface / statistics

Diff for /loncom/interface/statistics/lonstathelpers.pm between versions 1.22 and 1.29

version 1.22, 2004/09/16 14:28:19 version 1.29, 2004/11/03 16:13:08
Line 118  sub ProblemSelector { Line 118  sub ProblemSelector {
     my ($AcceptedResponseTypes) = @_;      my ($AcceptedResponseTypes) = @_;
     my $Str;      my $Str;
     $Str = "\n<table>\n";      $Str = "\n<table>\n";
       my $rb_count =0;
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {      foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {
         next if ($seq->{'num_assess'}<1);          next if ($seq->{'num_assess'}<1);
         my $seq_str = '';          my $seq_str = '';
Line 141  sub ProblemSelector { Line 142  sub ProblemSelector {
                         if (! defined($title) || $title eq '') {                          if (! defined($title) || $title eq '') {
                             ($title) = ($res->{'src'} =~ m:/([^/]*)$:);                              ($title) = ($res->{'src'} =~ m:/([^/]*)$:);
                         }                          }
                         $seq_str .= '<tr><td>'.                          $seq_str .= '<tr>'.
   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.                              qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value" $checked /></td>}.
   '</td><td>'.                                        '<td><label for="'.$rb_count.'">'.$resptype.'</label></td>'.
   $resptype.'</td><td>'.                              '<td><label for="'.$rb_count.'">'.$title.'</label>';
   '<a href="'.$res->{'src'}.'">'.$title.'</a> ';  
 #  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';  
                         if (scalar(@{$partdata->{'ResponseIds'}}) > 1) {                          if (scalar(@{$partdata->{'ResponseIds'}}) > 1) {
                             $seq_str .= &mt('response').' '.$respid;                              $seq_str .= &mt('response').' '.$respid;
                         }                          }
                           $seq_str .= ('&nbsp;'x2).
                               qq{<a target="preview" href="$res->{'src'}">view</a>};
                         $seq_str .= "</td></tr>\n";                          $seq_str .= "</td></tr>\n";
                           $rb_count++;
                     }                      }
                 }                  }
             }              }
Line 169  sub ProblemSelector { Line 171  sub ProblemSelector {
   
 =pod  =pod
   
 =item &MultpleProblemSelector($navmap,$ResponseTypes,$selected,$inputname)  =item &MultipleProblemSelector($navmap,$selected,$inputname)
   
 Generate HTML with checkboxes for problem selection.  Generate HTML with checkboxes for problem selection.
   
Line 178  Input: Line 180  Input:
 $navmap: a navmap object.  If undef, navmaps will be called to create a  $navmap: a navmap object.  If undef, navmaps will be called to create a
 new object.  new object.
   
 $ResponseTypes: scalar containing regular expression which matches response   
 types.  Only those problems which contain the given response type will be   
 shown.  
   
 $selected: Scalar, Array, or hash reference of currently selected items.  $selected: Scalar, Array, or hash reference of currently selected items.
   
 $inputname: The name of the form elements to use for the checkboxs.  $inputname: The name of the form elements to use for the checkboxs.
Line 194  and their contents.  A checkbox is provi Line 192  and their contents.  A checkbox is provi
 ####################################################  ####################################################
 ####################################################  ####################################################
 sub MultipleProblemSelector {  sub MultipleProblemSelector {
     my ($navmap,$ReponseTypes,$inputname,$formname)=@_;      my ($navmap,$inputname,$formname)=@_;
     my $cid = $ENV{'request.course.id'};      my $cid = $ENV{'request.course.id'};
     my $Str;      my $Str;
     # Massage the input as needed.      # Massage the input as needed.
Line 209  sub MultipleProblemSelector { Line 207  sub MultipleProblemSelector {
     my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};      my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};
     # Header      # Header
     $Str .= <<"END";      $Str .= <<"END";
 <script>  <script language="JavaScript" type="text/javascript">
     function checkall(value, checkName) {      function checkall(value,seqid) {
         for (i=0; i<document.forms.$formname.elements.length; i++) {          for (i=0; i<document.forms.$formname.elements.length; i++) {
             ele = document.forms.$formname.elements[i];              ele = document.forms.$formname.elements[i];
             if (ele.name == '$inputname') {              if (ele.name == '$inputname') {
                 document.forms.$formname.elements[i].checked=value;                  if (seqid != null) {
                       itemid = document.forms.$formname.elements[i].id;
                       thing = itemid.split(':');
                       if (thing[0] == seqid) {
                           document.forms.$formname.elements[i].checked=value;
                       }
                   } else {
                       document.forms.$formname.elements[i].checked=value;
                   }
             }              }
         }          }
     }      }
Line 227  END Line 233  END
     $Str .= $/.'<table>'.$/;      $Str .= $/.'<table>'.$/;
     my $iterator = $navmap->getIterator(undef, undef, undef, 1);      my $iterator = $navmap->getIterator(undef, undef, undef, 1);
     my $sequence_string;      my $sequence_string;
       my $seq_id = 0;
     my @Accumulator = (&new_accumulator($ENV{'course.'.$cid.'.description'},      my @Accumulator = (&new_accumulator($ENV{'course.'.$cid.'.description'},
                                         '',                                          '',
                                         '',                                          '',
                                           $seq_id++,
                                         $inputname));                                          $inputname));
     my @Sequence_Data;      my @Sequence_Data;
     while (my $curRes = $iterator->next()) {      while (my $curRes = $iterator->next()) {
         if ($curRes == $iterator->END_MAP) {          if ($curRes == $iterator->END_MAP) {
             if (ref($Accumulator[-1]) eq 'CODE') {              if (ref($Accumulator[-1]) eq 'CODE') {
                 push(@Sequence_Data,&{$Accumulator[-1]}());                  my $old_accumulator = pop(@Accumulator);
                 pop(@Accumulator);                  push(@Sequence_Data,&{$old_accumulator}());
             }              }
         } elsif ($curRes == $iterator->BEGIN_MAP) {          } elsif ($curRes == $iterator->BEGIN_MAP) {
             # Not much to do here.              # Not much to do here.
         }          }
         next if (! ref($curRes));          next if (! ref($curRes));
         if ($curRes->is_map) {          if ($curRes->is_map) {
             push(@Accumulator,&new_accumulator($curRes->title,              push(@Accumulator,&new_accumulator($curRes->compTitle,
                                                $curRes->src,                                                 $curRes->src,
                                                $curRes->symb,                                                 $curRes->symb,
                                                  $seq_id++,
                                                $inputname));                                                 $inputname));
         } elsif ($curRes->is_problem) {          } elsif ($curRes->is_problem) {
             if (@Accumulator && $Accumulator[-1] ne '') {              if (@Accumulator && $Accumulator[-1] ne '') {
Line 259  END Line 268  END
         #my $seq = pop(@Sequence_Data);          #my $seq = pop(@Sequence_Data);
         next if (! defined($seq) || ref($seq) ne 'HASH');          next if (! defined($seq) || ref($seq) ne 'HASH');
         $Str.= '<tr><td colspan="2">'.          $Str.= '<tr><td colspan="2">'.
             '<b>'.&get_title($seq->{'title'},$seq->{'src'}).'</b>'.              '<b>'.$seq->{'title'}.'</b>'.('&nbsp;'x2).
               '<a href="javascript:checkall(true,'.$seq->{'id'}.')">'.
                                     &mt('Select').'</a>'.('&nbsp;'x2).
               '<a href="javascript:checkall(false,'.$seq->{'id'}.')">'.
                                     &mt('Unselect').'</a>'.('&nbsp;'x2).
             '</td></tr>'.$/;              '</td></tr>'.$/;
         $Str.= $seq->{'html'};          $Str.= $seq->{'html'};
     }      }
Line 278  sub get_title { Line 291  sub get_title {
 }  }
   
 sub new_accumulator {  sub new_accumulator {
     my ($title,$src,$symb,$inputname) = @_;      my ($title,$src,$symb,$seq_id,$inputname) = @_;
     my $target;      my $target;
       my $item_id=0;
     return       return 
         sub {          sub {
             if (@_) {               if (@_) { 
                 my ($res,$checked) = @_;                  my ($res,$checked) = @_;
                 $target.='<tr><td>'.                  $target.='<tr><td><label>'.
                     '<input type="checkbox" name="'.$inputname.'" ';                      '<input type="checkbox" name="'.$inputname.'" ';
                 if ($checked) {                  if ($checked) {
                     $target .= 'checked ';                      $target .= 'checked ';
                 }                  }
                   $target .= 'id="'.$seq_id.':'.$item_id++.'" ';
                 $target.=                   $target.= 
                     'value="'.&Apache::lonnet::escape($res->symb).'" />'.                      'value="'.&Apache::lonnet::escape($res->symb).'" />'.
                     '</td><td>'.&get_title($res->title,$res->symb).'</td>'.                      '&nbsp;'.$res->compTitle.'</label>'.
                     '</tr>'.$/;                      ('&nbsp;'x2).'<a target="preview" '.
                       'href="'.$res->src.'">view</a>'.
                       '</td></tr>'.$/;
             } else {               } else { 
                 if (defined($target)) {                  if (defined($target)) {
                     return { title => $title,                      return { title => $title,
                              symb  => $symb,                               symb  => $symb,
                              src   => $src,                               src   => $src,
                                id    => $seq_id,
                              html  => $target, };                                html  => $target, }; 
                 }                  }
                 return undef;                  return undef;
Line 566  sub GetStudentAnswers { Line 584  sub GetStudentAnswers {
                                                  &mt('last student'));                                                   &mt('last student'));
         $student->{'answer'} = $answer;          $student->{'answer'} = $answer;
     }      }
     &Apache::lonstathelpers::write_answer_cache();      &Apache::lonstathelpers::write_analysis_cache();
     return if ($c->aborted());      return if ($c->aborted());
     $r->rflush();      $r->rflush();
     # close progress window      # close progress window
Line 615  sub analyze_problem_as_student { Line 633  sub analyze_problem_as_student {
     my $returnvalue;      my $returnvalue;
     my $url = $resource->{'src'};      my $url = $resource->{'src'};
     my $symb = $resource->{'symb'};      my $symb = $resource->{'symb'};
     my $answer = &get_from_answer_cache($sname,$sdom,$symb,$partid,$respid);      my $analysis = &get_from_analysis_cache($sname,$sdom,$symb);
     if (defined($answer)) {      if (! defined($analysis)) {
         return($answer);          &Apache::lonnet::logthis('uncached analysis');
     }          my $courseid = $ENV{'request.course.id'};
     my $courseid = $ENV{'request.course.id'};          my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',
     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',                                              'grade_domain' => $sdom,
                                         'grade_domain' => $sdom,                                              'grade_username' => $sname,
                                         'grade_username' => $sname,                                              'grade_symb' => $symb,
                                         'grade_symb' => $symb,                                              'grade_courseid' => $courseid));
                                         'grade_courseid' => $courseid));          (my $garbage,$analysis)=split(/_HASH_REF__/,$Answ,2);
     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);          &store_analysis($sname,$sdom,$symb,$analysis);
     my %Answer=&Apache::lonnet::str2hash($Answ);      }
       my %Answer=&Apache::lonnet::str2hash($analysis);
     #      #
     undef($answer);      my $answer;
     foreach my $partid (@{$resource->{'parts'}}) {      foreach my $partid (@{$resource->{'parts'}}) {
         my $partdata = $resource->{'partdata'}->{$partid};          my $partdata = $resource->{'partdata'}->{$partid};
         foreach my $respid (@{$partdata->{'ResponseIds'}}) {          foreach my $respid (@{$partdata->{'ResponseIds'}}) {
Line 637  sub analyze_problem_as_student { Line 656  sub analyze_problem_as_student {
             $answer->{$partid}->{$respid} = &get_answer($prefix,$key,%Answer);              $answer->{$partid}->{$respid} = &get_answer($prefix,$key,%Answer);
         }          }
     }      }
     &store_answer($sname,$sdom,$symb,undef,undef,$answer);  
     if (! defined($partid)) {      if (! defined($partid)) {
         $returnvalue = $answer;          $returnvalue = $answer;
     } elsif (! defined($respid)) {      } elsif (! defined($respid)) {
Line 682  sub get_answer { Line 700  sub get_answer {
     return $returnvalue;      return $returnvalue;
 }  }
   
   
 #####################################################  #####################################################
 #####################################################  #####################################################
   
Line 692  sub get_answer { Line 709  sub get_answer {
   
 =over 4  =over 4
   
 =item &load_answer_cache($symb)  =item &load_analysis_cache($symb)
   
 Loads the cache for the given symb into memory from disk.    Loads the cache for the given symb into memory from disk.  
 Requires the cache filename be set.    Requires the cache filename be set.  
Line 707  Only should be called by &ensure_proper_ Line 724  Only should be called by &ensure_proper_
     my $current_symb = undef;      my $current_symb = undef;
     my %cache;      my %cache;
   
 sub load_answer_cache {  sub load_analysis_cache {
     my ($symb) = @_;      my ($symb) = @_;
     return if (! defined($cache_filename));      return if (! defined($cache_filename));
     if (! defined($current_symb) || $current_symb ne $symb) {      if (! defined($current_symb) || $current_symb ne $symb) {
Line 730  sub load_answer_cache { Line 747  sub load_answer_cache {
   
 =pod  =pod
   
 =item &get_from_answer_cache($sname,$sdom,$symb,$partid,$respid)  =item &get_from_analysis_cache($sname,$sdom,$symb,$partid,$respid)
   
 Returns the appropriate data from the cache, or undef if no data exists.  Returns the appropriate data from the cache, or undef if no data exists.
 If $respid is undefined, a hash ref containing the answers for the given   
 $partid is returned.  If $partid is undefined, a hash ref containing answers  
 for all of the parts is returned.  
   
 =cut  =cut
   
 #####################################################  #####################################################
 #####################################################  #####################################################
 sub get_from_answer_cache {  sub get_from_analysis_cache {
     my ($sname,$sdom,$symb,$partid,$respid) = @_;      my ($sname,$sdom,$symb) = @_;
     &ensure_proper_cache($symb);      &ensure_proper_cache($symb);
     my $returnvalue;      my $returnvalue;
     if (exists($cache{$sname.':'.$sdom}) &&      if (exists($cache{$sname.':'.$sdom})) {
         ref($cache{$sname.':'.$sdom}) eq 'HASH') {          $returnvalue = $cache{$sname.':'.$sdom};
         if (defined($partid) &&  
             exists($cache{$sname.':'.$sdom}->{$partid})) {  
             if (defined($respid) &&  
                 exists($cache{$sname.':'.$sdom}->{$partid}->{$respid})) {  
                 $returnvalue = $cache{$sname.':'.$sdom}->{$partid}->{$respid};  
             } else {  
                 $returnvalue = $cache{$sname.':'.$sdom}->{$partid};  
             }  
         } else {  
             $returnvalue = $cache{$sname.':'.$sdom};  
         }  
     } else {      } else {
         $returnvalue = undef;          $returnvalue = undef;
     }      }
Line 769  sub get_from_answer_cache { Line 772  sub get_from_answer_cache {
   
 =pod  =pod
   
 =item &write_answer_cache($symb)  =item &write_analysis_cache($symb)
   
 Writes the in memory cache to disk so that it can be read in with  Writes the in memory cache to disk so that it can be read in with
 &load_answer_cache($symb).  &load_analysis_cache($symb).
   
 =cut  =cut
   
 #####################################################  #####################################################
 #####################################################  #####################################################
 sub write_answer_cache {  sub write_analysis_cache {
     return if (! defined($current_symb) || ! defined($cache_filename));      return if (! defined($current_symb) || ! defined($cache_filename));
     my %cache_db;      my %cache_db;
     my $key = &Apache::lonnet::escape($current_symb);      my $key = &Apache::lonnet::escape($current_symb);
Line 802  sub write_answer_cache { Line 805  sub write_answer_cache {
 =item &ensure_proper_cache($symb)  =item &ensure_proper_cache($symb)
   
 Called to make sure we have the proper cache set up.  This is called  Called to make sure we have the proper cache set up.  This is called
 prior to every answer lookup.  prior to every analysis lookup.
   
 =cut  =cut
   
Line 812  sub ensure_proper_cache { Line 815  sub ensure_proper_cache {
     my ($symb) = @_;      my ($symb) = @_;
     my $cid = $ENV{'request.course.id'};      my $cid = $ENV{'request.course.id'};
     my $new_filename =  '/home/httpd/perl/tmp/'.      my $new_filename =  '/home/httpd/perl/tmp/'.
         'problemanalysis_'.$cid.'_answer_cache.db';          'problemanalysis_'.$cid.'_analysis_cache.db';
     if (! defined($cache_filename) ||      if (! defined($cache_filename) ||
         $cache_filename ne $new_filename ||          $cache_filename ne $new_filename ||
         ! defined($current_symb)   ||          ! defined($current_symb)   ||
         $current_symb ne $symb) {          $current_symb ne $symb) {
         $cache_filename = $new_filename;          $cache_filename = $new_filename;
         # Notice: $current_symb is not set to $symb until after the cache is          # Notice: $current_symb is not set to $symb until after the cache is
         # loaded.  This is what tells &load_answer_cache to load in a new          # loaded.  This is what tells &load_analysis_cache to load in a new
         # symb cache.          # symb cache.
         &load_answer_cache($symb);          &load_analysis_cache($symb);
         $current_symb = $symb;          $current_symb = $symb;
     }      }
 }  }
Line 831  sub ensure_proper_cache { Line 834  sub ensure_proper_cache {
   
 =pod  =pod
   
 =item &store_answer($sname,$sdom,$symb,$partid,$respid,$dataset)  =item &store_analysis($sname,$sdom,$symb,$partid,$respid,$dataset)
   
 Stores the answer data in the in memory cache.  Stores the analysis data in the in memory cache.
   
 =cut  =cut
   
 #####################################################  #####################################################
 #####################################################  #####################################################
 sub store_answer {  sub store_analysis {
     my ($sname,$sdom,$symb,$partid,$respid,$dataset) = @_;      my ($sname,$sdom,$symb,$dataset) = @_;
     return if ($symb ne $current_symb);      return if ($symb ne $current_symb);
     if (defined($partid)) {      $cache{$sname.':'.$sdom}=$dataset;
         if (defined($respid)) {  
             $cache{$sname.':'.$sdom}->{$partid}->{$respid} = $dataset;  
         } else {  
             $cache{$sname.':'.$sdom}->{$partid} = $dataset;  
         }  
     } else {  
         $cache{$sname.':'.$sdom}=$dataset;  
     }  
     return;      return;
 }  }
   
Line 1090  sub get_problem_data { Line 1085  sub get_problem_data {
                     $Partdata{$part}->{'_Options'}=$value;                      $Partdata{$part}->{'_Options'}=$value;
                 } elsif ($key eq 'concepts') {                  } elsif ($key eq 'concepts') {
                     $Partdata{$part}->{'_Concepts'}=$value;                      $Partdata{$part}->{'_Concepts'}=$value;
                   } elsif ($key eq 'items') {
                       $Partdata{$part}->{'_Items'}=$value;
                 } elsif ($key =~ /^concept\.(.*)$/) {                  } elsif ($key =~ /^concept\.(.*)$/) {
                     my $concept = $1;                      my $concept = $1;
                     foreach my $foil (@$value) {                      foreach my $foil (@$value) {
                         $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=                          $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
                                                                       $concept;                                                                        $concept;
                     }                      }
                 } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high)$/) {                  } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high|str_type)$/) {
                     $Partdata{$part}->{$key}=$value;                      $Partdata{$part}->{$key}=$value;
                 }                  }
             } else {              } else {
Line 1108  sub get_problem_data { Line 1105  sub get_problem_data {
                 } elsif ($key =~ /^foil\.value\.(.*)$/) {                  } elsif ($key =~ /^foil\.value\.(.*)$/) {
                     my $foil = $1;                      my $foil = $1;
                     $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;                      $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;
                   } elsif ($key eq 'answercomputed') {
                       $Partdata{$part}->{'answercomputed'} = $value;
                 }                  }
             }              }
         }          }
     }      }
       # Further debugging code
       if (0) {
           &Apache::lonnet::logthis('lonstathelpers::get_problem_data');
           &log_hash_ref(\%Partdata);
       }
     return %Partdata;      return %Partdata;
 }  }
   
   sub log_array_ref {
       my ($arrayref,$prefix) = @_;
       return if (ref($arrayref) ne 'ARRAY');
       if (! defined($prefix)) { $prefix = ''; };
       foreach my $v (@$arrayref) {
           if (ref($v) eq 'ARRAY') {
               &log_array_ref($v,$prefix.'  ');
           } elsif (ref($v) eq 'HASH') {
               &log_hash_ref($v,$prefix.'  ');
           } else {
               &Apache::lonnet::logthis($prefix.'"'.$v.'"');
           }
       }
   }
   
   sub log_hash_ref {
       my ($hashref,$prefix) = @_;
       return if (ref($hashref) ne 'HASH');
       if (! defined($prefix)) { $prefix = ''; };
       while (my ($k,$v) = each(%$hashref)) {
           if (ref($v) eq 'ARRAY') {
               &Apache::lonnet::logthis($prefix.'"'.$k.'" = array');
               &log_array_ref($v,$prefix.'  ');
           } elsif (ref($v) eq 'HASH') {
               &Apache::lonnet::logthis($prefix.'"'.$k.'" = hash');
               &log_hash_ref($v,$prefix.'  ');
           } else {
               &Apache::lonnet::logthis($prefix.'"'.$k.'" => "'.$v.'"');
           }
       }
   }
 ####################################################  ####################################################
 ####################################################  ####################################################
   
Line 1244  Returns: An array of scalars containing Line 1279  Returns: An array of scalars containing
 ####################################################  ####################################################
 ####################################################  ####################################################
 sub manage_caches {  sub manage_caches {
     my ($r,$formname,$inputname) = @_;      my ($r,$formname,$inputname,$update_message) = @_;
     &Apache::loncoursedata::clear_internal_caches();      &Apache::loncoursedata::clear_internal_caches();
     my $sectionkey =       my $sectionkey = 
         join(',',          join(',',
Line 1261  sub manage_caches { Line 1296  sub manage_caches {
         (exists($ENV{'form.prevenrollstatus'}) &&          (exists($ENV{'form.prevenrollstatus'}) &&
             $ENV{'form.prevenrollstatus'} ne $statuskey)              $ENV{'form.prevenrollstatus'} ne $statuskey)
         ) {          ) {
           if (defined($update_message)) {
               $r->print($update_message);
           }
         &Apache::lonstatistics::Gather_Full_Student_Data($r,$formname,          &Apache::lonstatistics::Gather_Full_Student_Data($r,$formname,
                                                          $inputname);                                                           $inputname);
               
     }      }
     #      #
     my @Buttons =       my @Buttons = 
Removed from v.1.22  
changed lines
  Added in v.1.29

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>