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

View of /FigKernelPackages/Stats.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (download) (as text) (annotate)
Thu Apr 2 01:11:22 2009 UTC (10 years, 7 months ago) by parrello
Branch: MAIN
CVS Tags: rast_rel_2009_05_18, myrast_rel40, mgrast_dev_05262011, mgrast_dev_04082011, rast_rel_2010_0928, mgrast_dev_06072011, rast_rel_2009_0925, rast_rel_2010_0526, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, rast_rel_2011_0119, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_0, mgrast_dev_04132011, mgrast_dev_04012011, rast_rel_2009_07_09, rast_rel_2010_0827, myrast_33, mgrast_dev_04052011, mgrast_dev_02222011
Changes since 1.7: +17 -0 lines
Added a method to extract saved messages.

package Stats;

    use strict;
    use Carp;
    use Tracer;

=head1 Statistical Reporting Object

=head2 Introduction

This package defines an object that can be used to track one or more totals and a list of
messages. The object is intially created in a blank state. Use the L</Add> method to add a
value to one of the totals. Use the L</AddMessage> method to add a message. The messages
will be returned as one long string with new-lines separating the individual messages. To
retrieve a counter value, use the L</Ask> method.

=cut

#: Constructor Stats->new();

=head2 Public Methods

=head3 new

    my $stats = Stats->new($name1, $name2, ... $nameN);

This is the constructor for the statistical reporting object. It returns an object
with no messages and zero or more counters, all set to 0. Note that there is no
need to prime the counters in this constructor, so

    my $stats = Stats->new();

is perfectly legal. In that case, the counters are created as they are needed. The advantage
to specifying names in the constructor is that they will appear on the output as having a
zero value when the statistics object is printed or dumped.

=over 4

=item name1, name2, ... nameN

Names of the counters to pre-create.

=back

=cut

sub new {
    # Get the parameters.
    my ($class, @names) = @_;
    # Put the specified counters into a hash.
    my %map = map { $_ => 0 } @names;
    # Create the new statistics object.
    my $self = { Messages => "", Map => \%map };
    # Bless and return it.
    bless $self;
    return $self;
}

=head3 Add

    my $newValue = $stats->Add($name, $value);

Add the specified value to the counter with the specified name. If the counter does not
exist, it will be created with a value of 0.

=over 4

=item name

Name of the counter to be created or updated.

=item value

Value to add to the counter. If omitted, a value of C<1> will be assumed.

=item RETURN

Returns the new value of the counter.

=back

=cut
#: Return Type $;
sub Add {
    # Get the parameters.
    my ($self, $name, $value) = @_;
    # Note that we can't use a simple "!$value", because then 0 would
    # be translated to 1.
    if (!defined $value) {
        $value = 1;
    }
    # Get the counter's current value. If it doesn't exist, use 0.
    my $current = $self->{Map}->{$name} || 0;
    # Update the counter by adding the value.
    my $retVal = $current + $value;
    $self->{Map}->{$name} = $retVal;
    # Return the new value.
    return $retVal;
}

=head3 Accumulate

    $stats->Accumulate($other);

Roll another statistics object's values into this object. The messages will be added to our message
list, and the values of the counters will be added together. If a counter exists only in this object,
it will not be affected. If a counter exists only in the other object, it will be copied into this
one.

=over 4

=item other

Other statistical object whose values are to be merged into this object.

=back

=cut

sub Accumulate {
    # Get the parameters.
    my ($self, $other) = @_;
    # Loop through the other object's values, merging them in.
    my $otherMap = $other->{Map};
    for my $key (keys %{$otherMap}) {
        Trace("Accumulating $key.") if T(4);
        $self->Add($key, $otherMap->{$key});
    }
    $self->AddMessage($other->{Messages});
}

=head3 Messages

    my @text = $stats->Messages();

Return a list of the messages stored in this object.

=cut

sub Messages {
    # Get the parameters.
    my ($self) = @_;
    # Split up the messages.
    my @retVal = split /\n/, $self->{Messages};
    # Return the result.
    return @retVal;
}

=head3 Ask

    my $counter = $stats->Ask($name);

Return the value of the named counter.

=over 4

=item name

Name of the counter whose value is desired.

=item RETURN

Returns the value of the named counter, or C<0> if the counter does not
exist.

=back

=cut

sub Ask {
    # Get the parameters.
    my ($self, $name) = @_;
    # Clear the return value.
    my $retVal = 0;
    # Get the map.
    my $map = $self->{Map};
    # If the counter exists, extract its value. This process insures that
    # non-existent statistical keys don't get created in the hash.
    if (exists $map->{$name}) {
        $retVal = $map->{$name};
    }
    # Return the result.
    return $retVal;
}

=head3 AddMessage

    $stats->AddMessage($text);

Add a message to the statistical object's message queue.

=over 4

=item text

The text of the message to add.

=back

=cut

sub AddMessage {
    # Get the parameters.
    my ($self, $text) = @_;
    # Perform an intelligent joining.
    my $current = $self->{Messages};
    # Only proceed if there's text being added. An empty message can be ignored.
    if ($text) {
        Trace("AddMessage: $text") if T(2);
        if (!$current) {
            # The first message is added unvarnished.
            $self->{Messages} = $text;
        } else {
            # Here we have a message to append to existing text.
            $self->{Messages} = "$current\n$text";
        }
    }
}

=head3 Show

    my $dataList = $stats->Show();

Display the statistics and messages in this object as a series of lines of text.

=cut
#: Return Type $;
sub Show {
    # Get the parameters.
    my ($self) = @_;
    # Create the return variable.
    my $retVal = "";
    # Get the map.
    my $map = $self->{Map};
    # Get the key list.
    my @keys = sort keys %{$map};
    # Convert all the statistics to integers.
    my %intMap;
    for my $statKey (@keys) {
        $intMap{$statKey} = sprintf("%d", $map->{$statKey});
    }
    # Compute the key size.
    my $keySize = Tracer::Max(map { length $_ } @keys) + 1;
    my $statSize = Tracer::Max(map { length "$intMap{$_}" } @keys) + 1;
    # Loop through the statistics.
    for my $statKey (@keys) {
        # Add the statistic and its value.
        $retVal .= Tracer::Pad($statKey, $keySize) .
                   Tracer::Pad($intMap{$statKey}, $statSize, 'left') . "\n";
    }
    # Display the messages.
    $retVal .= "\n" . $self->{Messages} . "\n";
    # Return the result.
    return $retVal;
}

=head3 Display

    my $dataList = $stats->Display();

Display the statistics in this object as a single line of text.

=cut
#: Return Type $;
sub Display {
    # Get the parameters.
    my ($self) = @_;
    # Create the return variable.
    my $retVal = "";
    # Get the map.
    my $map = $self->{Map};
    # Loop through the statistics.
    for my $statKey (sort keys %{$map}) {
        # Add the statistic and its value.
        my $statValue = $map->{$statKey};
        $retVal .= " $statKey = $statValue;";
    }
    # Return the result.
    return $retVal;
}

=head3 Map

    my $mapHash = $stats->Map();

Return a hash mapping each statistical key to its total.

=cut

sub Map {
    # Get the parameters.
    my ($self) = @_;
    # Return the map.
    return $self->{Map};
}

=head3 SortedResults

    my @sortedKeys = $stats->SortedResults();

Return a list of the statistical keys, sorted in order from largest to
smallest.

=cut

sub SortedResults {
    # Get the parameters.
    my ($self) = @_;
    # Get the map.
    my $map = $self->{Map};
    # Sort the keys. We negate because we want the highest values first.
    my @retVal = sort { -($map->{$a} <=> $map->{$b}) } keys %{$map};
    # Return the result.
    return @retVal;
}

=head3 Check

    my $flag = $stats->Check($counter => $period);

Increment the specified statistic and return TRUE if the result is a
multiple of the specified period. This is a helpful method for generating
periodic trace messages. For example,

    Trace($stats->Ask('frogs') . " frogs processed.") if $stats->Check(frogs => 100) && T(3);

will generate a trace message at level 3 for every 100 frogs processed.

=over 4

=item counter

Name of the relevant statistic.

=item period

Periodicity value.

=item RETURN

Returns TRUE if the new value of the statistic is a multiple of the periodicity, else FALSE.

=back

=cut

sub Check {
    # Get the parameters.
    my ($self, $counter, $period) = @_;
    # Increment the statistic.
    my $count = $self->Add($counter => 1);
    # Check the new value against the periodicity.
    my $retVal = ($count % $period == 0);
    # Return the result.
    return $retVal;
}

=head3 Progress

    my $percent = $stats->Progress($counter => $total);

Increment a statistic and return the percent progress toward a specified
total.

=over 4

=item counter

Name of the relevant statistic.

=item total

Total number of objects being counted.

=item RETURN

Returns the percent of the total objects processed, including the current one.

=back

=cut

sub Progress {
    # Get the parameters.
    my ($self, $counter, $total) = @_;
    # Compute the return value.
    my $retVal = $self->Add($counter => 1) * 100 / $total;
    # Return the result.
    return $retVal;
}


1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3