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

Annotation of /FigKernelPackages/Stats.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (view) (download) (as text)

1 : parrello 1.1 package Stats;
2 :    
3 :     use strict;
4 :     use Carp;
5 :     use Tracer;
6 :    
7 :     =head1 Statistical Reporting Object
8 :    
9 :     =head2 Introduction
10 :    
11 :     This package defines an object that can be used to track one or more totals and a list of
12 :     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
14 :     will be returned as one long string with new-lines separating the individual messages. To
15 : parrello 1.4 retrieve a counter value, use the L</Ask> method.
16 : parrello 1.1
17 :     =cut
18 :    
19 :     #: Constructor Stats->new();
20 :    
21 :     =head2 Public Methods
22 :    
23 :     =head3 new
24 :    
25 : parrello 1.3 my $stats = Stats->new($name1, $name2, ... $nameN);
26 : parrello 1.1
27 :     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
29 :     need to prime the counters in this constructor, so
30 :    
31 : parrello 1.3 my $stats = Stats->new();
32 : parrello 1.1
33 :     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
35 :     zero value when the statistics object is printed or dumped.
36 :    
37 :     =over 4
38 :    
39 :     =item name1, name2, ... nameN
40 :    
41 :     Names of the counters to pre-create.
42 :    
43 :     =back
44 :    
45 :     =cut
46 :    
47 :     sub new {
48 :     # Get the parameters.
49 :     my ($class, @names) = @_;
50 : parrello 1.4 # Put the specified counters into a hash.
51 :     my %map = map { $_ => 0 } @names;
52 : parrello 1.1 # Create the new statistics object.
53 : parrello 1.4 my $self = { Messages => "", Map => \%map };
54 : parrello 1.1 # Bless and return it.
55 :     bless $self;
56 :     return $self;
57 :     }
58 :    
59 :     =head3 Add
60 :    
61 : parrello 1.3 my $newValue = $stats->Add($name, $value);
62 : parrello 1.1
63 :     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.
65 :    
66 :     =over 4
67 :    
68 :     =item name
69 :    
70 :     Name of the counter to be created or updated.
71 :    
72 :     =item value
73 :    
74 :     Value to add to the counter. If omitted, a value of C<1> will be assumed.
75 :    
76 :     =item RETURN
77 :    
78 :     Returns the new value of the counter.
79 :    
80 :     =back
81 :    
82 :     =cut
83 :     #: Return Type $;
84 :     sub Add {
85 :     # Get the parameters.
86 : parrello 1.4 my ($self, $name, $value) = @_;
87 : parrello 1.1 # Note that we can't use a simple "!$value", because then 0 would
88 :     # be translated to 1.
89 :     if (!defined $value) {
90 :     $value = 1;
91 :     }
92 :     # Get the counter's current value. If it doesn't exist, use 0.
93 : parrello 1.4 my $current = $self->{Map}->{$name} || 0;
94 : parrello 1.1 # Update the counter by adding the value.
95 :     my $retVal = $current + $value;
96 : parrello 1.4 $self->{Map}->{$name} = $retVal;
97 : parrello 1.1 # Return the new value.
98 :     return $retVal;
99 :     }
100 :    
101 :     =head3 Accumulate
102 :    
103 : parrello 1.3 $stats->Accumulate($other);
104 : parrello 1.1
105 :     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,
107 :     it will not be affected. If a counter exists only in the other object, it will be copied into this
108 :     one.
109 :    
110 :     =over 4
111 :    
112 :     =item other
113 :    
114 :     Other statistical object whose values are to be merged into this object.
115 :    
116 :     =back
117 :    
118 :     =cut
119 :    
120 :     sub Accumulate {
121 :     # Get the parameters.
122 :     my ($self, $other) = @_;
123 :     # Loop through the other object's values, merging them in.
124 : parrello 1.4 my $otherMap = $other->{Map};
125 :     for my $key (keys %{$otherMap}) {
126 :     Trace("Accumulating $key.") if T(4);
127 :     $self->Add($key, $otherMap->{$key});
128 : parrello 1.1 }
129 : parrello 1.4 $self->AddMessage($other->{Messages});
130 : parrello 1.1 }
131 :    
132 : parrello 1.8 =head3 Messages
133 :    
134 :     my @text = $stats->Messages();
135 :    
136 :     Return a list of the messages stored in this object.
137 :    
138 :     =cut
139 :    
140 :     sub Messages {
141 :     # Get the parameters.
142 :     my ($self) = @_;
143 :     # Split up the messages.
144 :     my @retVal = split /\n/, $self->{Messages};
145 :     # Return the result.
146 :     return @retVal;
147 :     }
148 :    
149 : parrello 1.1 =head3 Ask
150 :    
151 : parrello 1.3 my $counter = $stats->Ask($name);
152 : parrello 1.1
153 :     Return the value of the named counter.
154 :    
155 :     =over 4
156 :    
157 :     =item name
158 :    
159 :     Name of the counter whose value is desired.
160 :    
161 :     =item RETURN
162 :    
163 :     Returns the value of the named counter, or C<0> if the counter does not
164 :     exist.
165 :    
166 :     =back
167 :    
168 :     =cut
169 :    
170 :     sub Ask {
171 :     # Get the parameters.
172 :     my ($self, $name) = @_;
173 :     # Clear the return value.
174 :     my $retVal = 0;
175 : parrello 1.4 # Get the map.
176 :     my $map = $self->{Map};
177 :     # If the counter exists, extract its value. This process insures that
178 :     # non-existent statistical keys don't get created in the hash.
179 :     if (exists $map->{$name}) {
180 :     $retVal = $map->{$name};
181 : parrello 1.1 }
182 :     # Return the result.
183 :     return $retVal;
184 :     }
185 :    
186 :     =head3 AddMessage
187 :    
188 : parrello 1.3 $stats->AddMessage($text);
189 : parrello 1.1
190 :     Add a message to the statistical object's message queue.
191 :    
192 :     =over 4
193 :    
194 :     =item text
195 :    
196 :     The text of the message to add.
197 :    
198 :     =back
199 :    
200 :     =cut
201 :    
202 :     sub AddMessage {
203 :     # Get the parameters.
204 :     my ($self, $text) = @_;
205 :     # Perform an intelligent joining.
206 :     my $current = $self->{Messages};
207 :     # Only proceed if there's text being added. An empty message can be ignored.
208 :     if ($text) {
209 :     Trace("AddMessage: $text") if T(2);
210 :     if (!$current) {
211 :     # The first message is added unvarnished.
212 :     $self->{Messages} = $text;
213 :     } else {
214 :     # Here we have a message to append to existing text.
215 :     $self->{Messages} = "$current\n$text";
216 :     }
217 :     }
218 :     }
219 :    
220 :     =head3 Show
221 :    
222 : parrello 1.3 my $dataList = $stats->Show();
223 : parrello 1.1
224 : parrello 1.2 Display the statistics and messages in this object as a series of lines of text.
225 : parrello 1.1
226 :     =cut
227 :     #: Return Type $;
228 :     sub Show {
229 :     # Get the parameters.
230 :     my ($self) = @_;
231 :     # Create the return variable.
232 :     my $retVal = "";
233 : parrello 1.4 # Get the map.
234 :     my $map = $self->{Map};
235 : parrello 1.7 # Get the key list.
236 :     my @keys = sort keys %{$map};
237 :     # Convert all the statistics to integers.
238 :     my %intMap;
239 :     for my $statKey (@keys) {
240 :     $intMap{$statKey} = sprintf("%d", $map->{$statKey});
241 :     }
242 : parrello 1.4 # Compute the key size.
243 : parrello 1.7 my $keySize = Tracer::Max(map { length $_ } @keys) + 1;
244 :     my $statSize = Tracer::Max(map { length "$intMap{$_}" } @keys) + 1;
245 : parrello 1.1 # Loop through the statistics.
246 : parrello 1.7 for my $statKey (@keys) {
247 : parrello 1.4 # Add the statistic and its value.
248 :     $retVal .= Tracer::Pad($statKey, $keySize) .
249 : parrello 1.7 Tracer::Pad($intMap{$statKey}, $statSize, 'left') . "\n";
250 : parrello 1.1 }
251 :     # Display the messages.
252 :     $retVal .= "\n" . $self->{Messages} . "\n";
253 :     # Return the result.
254 :     return $retVal;
255 :     }
256 :    
257 : parrello 1.2 =head3 Display
258 :    
259 : parrello 1.3 my $dataList = $stats->Display();
260 : parrello 1.2
261 :     Display the statistics in this object as a single line of text.
262 :    
263 :     =cut
264 :     #: Return Type $;
265 :     sub Display {
266 :     # Get the parameters.
267 :     my ($self) = @_;
268 :     # Create the return variable.
269 :     my $retVal = "";
270 : parrello 1.4 # Get the map.
271 :     my $map = $self->{Map};
272 : parrello 1.2 # Loop through the statistics.
273 : parrello 1.4 for my $statKey (sort keys %{$map}) {
274 :     # Add the statistic and its value.
275 :     my $statValue = $map->{$statKey};
276 :     $retVal .= " $statKey = $statValue;";
277 : parrello 1.2 }
278 :     # Return the result.
279 :     return $retVal;
280 :     }
281 :    
282 : parrello 1.4 =head3 Map
283 :    
284 :     my $mapHash = $stats->Map();
285 :    
286 :     Return a hash mapping each statistical key to its total.
287 :    
288 :     =cut
289 :    
290 :     sub Map {
291 :     # Get the parameters.
292 :     my ($self) = @_;
293 :     # Return the map.
294 :     return $self->{Map};
295 :     }
296 :    
297 : parrello 1.5 =head3 SortedResults
298 :    
299 :     my @sortedKeys = $stats->SortedResults();
300 :    
301 :     Return a list of the statistical keys, sorted in order from largest to
302 :     smallest.
303 :    
304 :     =cut
305 :    
306 :     sub SortedResults {
307 :     # Get the parameters.
308 :     my ($self) = @_;
309 :     # Get the map.
310 :     my $map = $self->{Map};
311 :     # Sort the keys. We negate because we want the highest values first.
312 :     my @retVal = sort { -($map->{$a} <=> $map->{$b}) } keys %{$map};
313 :     # Return the result.
314 :     return @retVal;
315 :     }
316 :    
317 : parrello 1.6 =head3 Check
318 :    
319 :     my $flag = $stats->Check($counter => $period);
320 :    
321 :     Increment the specified statistic and return TRUE if the result is a
322 :     multiple of the specified period. This is a helpful method for generating
323 :     periodic trace messages. For example,
324 :    
325 :     Trace($stats->Ask('frogs') . " frogs processed.") if $stats->Check(frogs => 100) && T(3);
326 :    
327 :     will generate a trace message at level 3 for every 100 frogs processed.
328 :    
329 :     =over 4
330 :    
331 :     =item counter
332 :    
333 :     Name of the relevant statistic.
334 :    
335 :     =item period
336 :    
337 :     Periodicity value.
338 :    
339 :     =item RETURN
340 :    
341 :     Returns TRUE if the new value of the statistic is a multiple of the periodicity, else FALSE.
342 :    
343 :     =back
344 :    
345 :     =cut
346 :    
347 :     sub Check {
348 :     # Get the parameters.
349 :     my ($self, $counter, $period) = @_;
350 :     # Increment the statistic.
351 :     my $count = $self->Add($counter => 1);
352 :     # Check the new value against the periodicity.
353 :     my $retVal = ($count % $period == 0);
354 :     # Return the result.
355 :     return $retVal;
356 :     }
357 :    
358 :     =head3 Progress
359 :    
360 :     my $percent = $stats->Progress($counter => $total);
361 :    
362 :     Increment a statistic and return the percent progress toward a specified
363 :     total.
364 :    
365 :     =over 4
366 :    
367 :     =item counter
368 :    
369 :     Name of the relevant statistic.
370 :    
371 :     =item total
372 :    
373 :     Total number of objects being counted.
374 :    
375 :     =item RETURN
376 :    
377 :     Returns the percent of the total objects processed, including the current one.
378 :    
379 :     =back
380 :    
381 :     =cut
382 :    
383 :     sub Progress {
384 :     # Get the parameters.
385 :     my ($self, $counter, $total) = @_;
386 :     # Compute the return value.
387 :     my $retVal = $self->Add($counter => 1) * 100 / $total;
388 :     # Return the result.
389 :     return $retVal;
390 :     }
391 :    
392 : parrello 1.5
393 : parrello 1.3 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3