package Tool::Box;

@ISA         = qw(Exporter);
@EXPORT      = qw();
@EXPORT_OK   = qw( ave uniq uniq_ordered stats);
%EXPORT_TAGS = ( ':ALL'   => [ qw(pairwise ave uniq stats) ] );

$VERSION = '0.01';

use strict;
use warnings;
use Carp;
use UNIVERSAL 'isa';

sub ave {
    my $tot;
    my $cnt;
    my $find_ave = sub {
        $cnt += @_;
        $tot += $_ for @_;
        return $cnt ? $tot / $cnt : undef;
    };
    return @_ ? $find_ave->( @_ ) : $find_ave;
}

sub uniq {
    my %uniq;
    my $find_uniq = sub {
        @uniq{ @_ } = ();
        if ( defined wantarray ) {
            return wantarray ? keys %uniq : scalar keys %uniq;
        }
    };
    return @_ ? $find_uniq->( @_ ) : $find_uniq;
}

sub uniq_ordered {
    my (@uniq, %seen);
    my $uniq_ordered = sub {
        for ( @_ ) {
            push @uniq, $_ if ! $seen{$_}++;
        }
        if ( defined wantarray ) {
            return wantarray ? @uniq : scalar @_;
        }
    };
    return @_ ? $uniq_ordered->( @_ ) : $uniq_ordered;
}

sub stats {
    my $stat = {};
    my ($cnt, $max, $min, $tot);

    $stat->{ADD} = sub {
        $cnt += @_;
        for ( @_ ) {
            $tot += $_;
            $max = $_ if ! defined $max || $_ > $max;
            $min = $_ if ! defined $min || $_ < $min;
        }
    };

    $stat->{CNT} = sub { $cnt };
    $stat->{MAX} = sub { $max };
    $stat->{MIN} = sub { $min };
    $stat->{AVE} = sub { $cnt ? $tot / $cnt : undef };
    $stat->{TOT} = sub { $tot };

    return @_ ? ($cnt, $tot, $min, $max, $cnt ? $tot / $cnt : undef) :
+ $stat;
}

42;

__END__

=head1 NAME

Tool::Box - A hodge podge of useful functions

=head1 VERSION

Version 0.01

=head1 SYNOPSIS

 use Tool::Box;
 use Tool::Box qw(uniq ave);
 use Tool::Box ':ALL';

=head1 DESCRIPTION

This module is a collection of commonly used functions to do what you 
+want how you want. 

=head1 EXPORTS

None by default

=head1 FUNCTIONS

=head2 ave

C<ave> returns a function that allows you to keep track an average ove
+r
the course of a program.  If it is called with a an argument list, it
returns the average of that list instead of a function.

  use Tool::Box qw(ave);
  print ave(5, 10, -1, 7.3); # 5.325

  my $ave = ave();
  for (4 .. 9) {
      $ave->( $_ );
  }
  print $ave->();  # 6.5

=head2 uniq

C<uniq> returns a function that allows you to keep track of unique sca
+lars
over the course of a program.  The resulting function will return noth
+ing
if called in a void context, a unique list if list context, and a coun
+t of
unique scalars in list context.

If the original function is called with an argument list, it returns a
+ list
of unique scalars instead of a function.

If you need the list to be returned in the order that the scalars were
+ first
seen, use L<uniq_ordered>.

  use Tool::Box qw(uniq);
  print join ' ', uniq(1,1,2,3,1,7); # 1 2 3 7 though order is not gua
+ranteed

  my $uniq = uniq();
  my $count = $uniq->(1,1,2,3,1,7);
  print $count;  # 4

  while ( <DATA> ) {
      $uniq->( $_ );
  }
  my $unique_lines = $uniq->(); # number of unique lines in __DATA__

=head2 uniq_ordered

C<uniq_ordered> works identical to L<uniq> except that it guarantees t
+he order
of unique scalars is returned in the same order as they were first see
+n

=head2 stats

C<stats> returns a function that allows you to keep track of cnt/max/m
+in/ave/tot
over the course of a program.

If the original function is called with an argument list, it returns t
+he 
count, total, minimum, maximum, and average instead of a function.

  use Tool::Box qw(stats);
  my ($cnt, $tot, $min, $max, $ave) = stats(1 .. 10);

  my $stat = stats();
  for (8 .. 12) {
      $stat->{ADD}( $_ );
  }
  print $stat->{MAX}();  # 12 
  print $stat->{TOT}();  # 50 
  print $stat->{CNT}();  # 5

=head1 AUTHOR

Joshua Gatcomb, <Limbic_Region_2000@Yahoo.com>

=head1 ACKNOWLEDGEMENTS

Various people from PerlMonks (L<http://www.perlmonks.org>) provided
invaluable input.

=head1 BUGS

Functions that expect numeric arguments are not verifying they are num
+eric

=head1 TO DO
Combinations [id://393064]
Combination powerset [id://394168]
Intersection/Difference of arrays (more than two?)
Is X present in @array (various forms) [id://371938]
L<List::Util>'s C<reduce> using a closure

=head1 COPYRIGHT

 Copyright (c) 2004 Joshua Gatcomb. All rights reserved.
 This program is free software; you can redistribute it
 and/or modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<perl>(1)

=cut
[download]