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

Annotation of /FigKernelPackages/Stats.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (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 :     =head3 Ask
133 :    
134 : parrello 1.3 my $counter = $stats->Ask($name);
135 : parrello 1.1
136 :     Return the value of the named counter.
137 :    
138 :     =over 4
139 :    
140 :     =item name
141 :    
142 :     Name of the counter whose value is desired.
143 :    
144 :     =item RETURN
145 :    
146 :     Returns the value of the named counter, or C<0> if the counter does not
147 :     exist.
148 :    
149 :     =back
150 :    
151 :     =cut
152 :    
153 :     sub Ask {
154 :     # Get the parameters.
155 :     my ($self, $name) = @_;
156 :     # Clear the return value.
157 :     my $retVal = 0;
158 : parrello 1.4 # Get the map.
159 :     my $map = $self->{Map};
160 :     # 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 : parrello 1.1 }
165 :     # Return the result.
166 :     return $retVal;
167 :     }
168 :    
169 :     =head3 AddMessage
170 :    
171 : parrello 1.3 $stats->AddMessage($text);
172 : parrello 1.1
173 :     Add a message to the statistical object's message queue.
174 :    
175 :     =over 4
176 :    
177 :     =item text
178 :    
179 :     The text of the message to add.
180 :    
181 :     =back
182 :    
183 :     =cut
184 :    
185 :     sub AddMessage {
186 :     # Get the parameters.
187 :     my ($self, $text) = @_;
188 :     # Perform an intelligent joining.
189 :     my $current = $self->{Messages};
190 :     # Only proceed if there's text being added. An empty message can be ignored.
191 :     if ($text) {
192 :     Trace("AddMessage: $text") if T(2);
193 :     if (!$current) {
194 :     # The first message is added unvarnished.
195 :     $self->{Messages} = $text;
196 :     } else {
197 :     # Here we have a message to append to existing text.
198 :     $self->{Messages} = "$current\n$text";
199 :     }
200 :     }
201 :     }
202 :    
203 :     =head3 Show
204 :    
205 : parrello 1.3 my $dataList = $stats->Show();
206 : parrello 1.1
207 : parrello 1.2 Display the statistics and messages in this object as a series of lines of text.
208 : parrello 1.1
209 :     =cut
210 :     #: Return Type $;
211 :     sub Show {
212 :     # Get the parameters.
213 :     my ($self) = @_;
214 :     # Create the return variable.
215 :     my $retVal = "";
216 : parrello 1.4 # 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 : parrello 1.1 # Loop through the statistics.
222 : parrello 1.4 for my $statKey (sort keys %{$map}) {
223 :     # Add the statistic and its value.
224 :     my $statValue = $map->{$statKey};
225 :     $retVal .= Tracer::Pad($statKey, $keySize) .
226 :     Tracer::Pad($statValue, $statSize, 'left') . "\n";
227 : parrello 1.1 }
228 :     # Display the messages.
229 :     $retVal .= "\n" . $self->{Messages} . "\n";
230 :     # Return the result.
231 :     return $retVal;
232 :     }
233 :    
234 : parrello 1.2 =head3 Display
235 :    
236 : parrello 1.3 my $dataList = $stats->Display();
237 : parrello 1.2
238 :     Display the statistics in this object as a single line of text.
239 :    
240 :     =cut
241 :     #: Return Type $;
242 :     sub Display {
243 :     # Get the parameters.
244 :     my ($self) = @_;
245 :     # Create the return variable.
246 :     my $retVal = "";
247 : parrello 1.4 # Get the map.
248 :     my $map = $self->{Map};
249 : parrello 1.2 # Loop through the statistics.
250 : parrello 1.4 for my $statKey (sort keys %{$map}) {
251 :     # Add the statistic and its value.
252 :     my $statValue = $map->{$statKey};
253 :     $retVal .= " $statKey = $statValue;";
254 : parrello 1.2 }
255 :     # Return the result.
256 :     return $retVal;
257 :     }
258 :    
259 : parrello 1.4 =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 : parrello 1.5 =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 : parrello 1.3 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3