[Bio] / FigKernelPackages / Stats.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Stats.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2, Tue Feb 6 16:25:18 2007 UTC revision 1.5, Tue Apr 29 05:49:26 2008 UTC
# Line 12  Line 12 
12  messages. The object is intially created in a blank state. Use the L</Add> method to add a  messages. The object is intially created in a blank state. Use the L</Add> method to add a
13  value to one of the totals. Use the L</AddMessage> method to add a message. The messages  value to one of the totals. Use the L</AddMessage> method to add a message. The messages
14  will be returned as one long string with new-lines separating the individual messages. To  will be returned as one long string with new-lines separating the individual messages. To
15  retrieve a counter value, use its name as a hash key. Thus, C<< $stats->{rows} >> would be  retrieve a counter value, use the L</Ask> method.
 the value of the C<rows> counter. The messages are stored under the key C<Messages>.  
16    
17  =cut  =cut
18    
# Line 23  Line 22 
22    
23  =head3 new  =head3 new
24    
25  C<< my $stats = Stats->new($name1, $name2, ... $nameN); >>      my $stats = Stats->new($name1, $name2, ... $nameN);
26    
27  This is the constructor for the statistical reporting object. It returns an object  This is the constructor for the statistical reporting object. It returns an object
28  with no messages and zero or more counters, all set to 0. Note that there is no  with no messages and zero or more counters, all set to 0. Note that there is no
29  need to prime the counters in this constructor, so  need to prime the counters in this constructor, so
30    
31  C<< my $stats = Stats->new(); >>      my $stats = Stats->new();
32    
33  is perfectly legal. In that case, the counters are created as they are needed. The advantage  is perfectly legal. In that case, the counters are created as they are needed. The advantage
34  to specifying names in the constructor is that they will appear on the output as having a  to specifying names in the constructor is that they will appear on the output as having a
# Line 48  Line 47 
47  sub new {  sub new {
48      # Get the parameters.      # Get the parameters.
49      my ($class, @names) = @_;      my ($class, @names) = @_;
50        # Put the specified counters into a hash.
51        my %map = map { $_ => 0 } @names;
52      # Create the new statistics object.      # Create the new statistics object.
53      my $self = { Messages => "" };      my $self = { Messages => "", Map => \%map };
     # Put the specified counters into it.  
     for my $name (@names) {  
         $self->{$name} = 0;  
     }  
54      # Bless and return it.      # Bless and return it.
55      bless $self;      bless $self;
56      return $self;      return $self;
# Line 61  Line 58 
58    
59  =head3 Add  =head3 Add
60    
61  C<< my $newValue = $stats->Add($name, $value); >>      my $newValue = $stats->Add($name, $value);
62    
63  Add the specified value to the counter with the specified name. If the counter does not  Add the specified value to the counter with the specified name. If the counter does not
64  exist, it will be created with a value of 0.  exist, it will be created with a value of 0.
# Line 93  Line 90 
90          $value = 1;          $value = 1;
91      }      }
92      # Get the counter's current value. If it doesn't exist, use 0.      # Get the counter's current value. If it doesn't exist, use 0.
93      my $current = $self->{$name};      my $current = $self->{Map}->{$name} || 0;
     if (!$current) {  
         $current = 0;  
     }  
94      # Update the counter by adding the value.      # Update the counter by adding the value.
95      my $retVal = $current + $value;      my $retVal = $current + $value;
96      $self->{$name} = $retVal;      $self->{Map}->{$name} = $retVal;
97      # Return the new value.      # Return the new value.
98      return $retVal;      return $retVal;
99  }  }
100    
101  =head3 Accumulate  =head3 Accumulate
102    
103  C<< $stats->Accumulate($other); >>      $stats->Accumulate($other);
104    
105  Roll another statistics object's values into this object. The messages will be added to our message  Roll another statistics object's values into this object. The messages will be added to our message
106  list, and the values of the counters will be added together. If a counter exists only in this object,  list, and the values of the counters will be added together. If a counter exists only in this object,
# Line 127  Line 121 
121      # Get the parameters.      # Get the parameters.
122      my ($self, $other) = @_;      my ($self, $other) = @_;
123      # Loop through the other object's values, merging them in.      # Loop through the other object's values, merging them in.
124      while (my ($name,$value) = each %{$other}) {      my $otherMap = $other->{Map};
125          if ($name eq "Messages") {      for my $key (keys %{$otherMap}) {
126              $self->AddMessage($value);          Trace("Accumulating $key.") if T(4);
127          } else {          $self->Add($key, $otherMap->{$key});
             $self->Add($name, $value);  
         }  
128      }      }
129        $self->AddMessage($other->{Messages});
130  }  }
131    
132  =head3 Ask  =head3 Ask
133    
134  C<< my $counter = $stats->Ask($name); >>      my $counter = $stats->Ask($name);
135    
136  Return the value of the named counter.  Return the value of the named counter.
137    
# Line 162  Line 155 
155      my ($self, $name) = @_;      my ($self, $name) = @_;
156      # Clear the return value.      # Clear the return value.
157      my $retVal = 0;      my $retVal = 0;
158      # If the counter exists, save its value.      # Get the map.
159      if (exists $self->{$name}) {      my $map = $self->{Map};
160          $retVal = $self->{$name};      # If the counter exists, extract its value. This process insures that
161        # non-existent statistical keys don't get created in the hash.
162        if (exists $map->{$name}) {
163            $retVal = $map->{$name};
164      }      }
165      # Return the result.      # Return the result.
166      return $retVal;      return $retVal;
# Line 172  Line 168 
168    
169  =head3 AddMessage  =head3 AddMessage
170    
171  C<< $stats->AddMessage($text); >>      $stats->AddMessage($text);
172    
173  Add a message to the statistical object's message queue.  Add a message to the statistical object's message queue.
174    
# Line 206  Line 202 
202    
203  =head3 Show  =head3 Show
204    
205  C<< my $dataList = $stats->Show(); >>      my $dataList = $stats->Show();
206    
207  Display the statistics and messages in this object as a series of lines of text.  Display the statistics and messages in this object as a series of lines of text.
208    
# Line 217  Line 213 
213      my ($self) = @_;      my ($self) = @_;
214      # Create the return variable.      # Create the return variable.
215      my $retVal = "";      my $retVal = "";
216        # Get the map.
217        my $map = $self->{Map};
218        # Compute the key size.
219        my $keySize = Tracer::Max(map { length $_ } keys %{$map}) + 1;
220        my $statSize = Tracer::Max(map { length "$map->{$_}" } keys %{$map}) + 1;
221      # Loop through the statistics.      # Loop through the statistics.
222      for my $statKey (sort keys %{$self}) {      for my $statKey (sort keys %{$map}) {
         # Only proceed if this is not the message queue.  
         if ($statKey ne "Messages") {  
223              # Add the statistic and its value.              # Add the statistic and its value.
224              my $statValue = $self->{$statKey};          my $statValue = $map->{$statKey};
225              $retVal .= "$statKey\t$statValue\n";          $retVal .= Tracer::Pad($statKey, $keySize) .
226          }                     Tracer::Pad($statValue, $statSize, 'left') . "\n";
227      }      }
228      # Display the messages.      # Display the messages.
229      $retVal .= "\n" . $self->{Messages} . "\n";      $retVal .= "\n" . $self->{Messages} . "\n";
# Line 234  Line 233 
233    
234  =head3 Display  =head3 Display
235    
236  C<< my $dataList = $stats->Display(); >>      my $dataList = $stats->Display();
237    
238  Display the statistics in this object as a single line of text.  Display the statistics in this object as a single line of text.
239    
# Line 245  Line 244 
244      my ($self) = @_;      my ($self) = @_;
245      # Create the return variable.      # Create the return variable.
246      my $retVal = "";      my $retVal = "";
247        # Get the map.
248        my $map = $self->{Map};
249      # Loop through the statistics.      # Loop through the statistics.
250      for my $statKey (sort keys %{$self}) {      for my $statKey (sort keys %{$map}) {
         # Only proceed if this is not the message queue.  
         if ($statKey ne "Messages") {  
251              # Add the statistic and its value.              # Add the statistic and its value.
252              my $statValue = $self->{$statKey};          my $statValue = $map->{$statKey};
253              $retVal .= " $statKey = $statValue;";              $retVal .= " $statKey = $statValue;";
254          }          }
     }  
255      # Return the result.      # Return the result.
256      return $retVal;      return $retVal;
257  }  }
258    
259    =head3 Map
260    
261        my $mapHash = $stats->Map();
262    
263    Return a hash mapping each statistical key to its total.
264    
265    =cut
266    
267    sub Map {
268        # Get the parameters.
269        my ($self) = @_;
270        # Return the map.
271        return $self->{Map};
272    }
273    
274    =head3 SortedResults
275    
276        my @sortedKeys = $stats->SortedResults();
277    
278    Return a list of the statistical keys, sorted in order from largest to
279    smallest.
280    
281    =cut
282    
283    sub SortedResults {
284        # Get the parameters.
285        my ($self) = @_;
286        # Get the map.
287        my $map = $self->{Map};
288        # Sort the keys. We negate because we want the highest values first.
289        my @retVal = sort { -($map->{$a} <=> $map->{$b}) } keys %{$map};
290        # Return the result.
291        return @retVal;
292    }
293    
294    
295  1;  1;

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3