Statistics-Basic-1.6607/0000750000175000017500000000000011707262606014702 5ustar jetterojetteroStatistics-Basic-1.6607/lib/0000750000175000017500000000000011707262605015447 5ustar jetterojetteroStatistics-Basic-1.6607/lib/Statistics/0000750000175000017500000000000011707262605017601 5ustar jetterojetteroStatistics-Basic-1.6607/lib/Statistics/Basic.pod0000644000175000017500000005351711707262464021351 0ustar jetterojettero=head1 NAME Statistics::Basic - A collection of very basic statistics modules =head1 SYNOPSIS use Statistics::Basic qw(:all); These actually return objects, not numbers. The objects will interpolate as nicely formated numbers (using L). Or the actual number will be returned when the object is used as a number. my $median = median( 1,2,3 ); my $mean = mean( [1,2,3]); # array refs are ok too my $variance = variance( 1,2,3 ); my $stddev = stddev( 1,2,3 ); Although passing unblessed numbers and array refs to these functions works, it's sometimes better to pass vector objects so the objects can reuse calculated values. my $v1 = $mean->query_vector; my $variance = variance( $v1 ); my $stddev = stddev( $v1 ); Here, the mean used by the variance and the variance used by the standard deviation will not need to be recalculated. Now consider these two calculations. my $covariance = covariance( [1 .. 3], [1 .. 3] ); my $correlation = correlation( [1 .. 3], [1 .. 3] ); The covariance above would need to be recalculated by the correlation when these functions are called this way. But, if we instead built vectors first, that wouldn't happen: # $v1 is defined above my $v2 = vector(1,2,3); my $cov = covariance( $v1, $v2 ); my $cor = correlation( $v1, $v2 ); Now C<$cor> can reuse the variance calculated in C<$cov>. All of the functions above return objects that interpolate or evaluate as a single string or as a number. L and L are different: my $unimodal = mode(1,2,3,3); my $multimodal = mode(1,2,3); print "The modes are: $unimodal and $multimodal.\n"; print "The first is multimodal... " if $unimodal->is_multimodal; print "The second is multimodal.\n" if $multimodal->is_multimodal; In the first case, C<$unimodal> will interpolate as a string B function correctly as a number. However, in the second case, trying to use C<$multimodal> as a number will C an error -- it still interpolates fine though. my $lsf = leastsquarefit($v1, $v2); This C<$lsf> will interpolate fine, showing C, but it will C if you try to use the object as a number. my $v3 = $multimodal->query; my ($alpha, $beta) = $lsf->query; my $average = $mean->query; All of the objects allow you to explicitly query, if you're not in the mood to use L. my @answers = ( $mode->query, $median->query, $stddev->query, ); =head1 SHORTCUTS The following shortcut functions can be used in place of calling the module's C method directly. They all take either array refs B lists as arguments, with the exception of the shortcuts that need two vectors to process (e.g. L). =over =item B Returns a L object. Arguments to C can be any of: an array ref, a list of numbers, or a blessed vector object. If passed a blessed vector object, vector will just return the vector passed in. =item B B B Returns a L object. You can choose to call C as C or C. Arguments can be any of: an array ref, a list of numbers, or a blessed vector object. =item B Returns a L object. Arguments can be any of: an array ref, a list of numbers, or a blessed vector object. =item B Returns a L object. Arguments can be any of: an array ref, a list of numbers, or a blessed vector object. =item B B Returns a L object. You can choose to call C as C. Arguments can be any of: an array ref, a list of numbers, or a blessed vector object. If you will also be calculating the mean of the same list of numbers it's recommended to do this: my $vec = vector(1,2,3); my $mean = mean($vec); my $var = variance($vec); This would also work: my $mean = mean(1,2,3); my $var = variance($mean->query_vector); This will calculate the same mean twice: my $mean = mean(1,2,3); my $var = variance(1,2,3); If you really only need the variance, ignore the above and this is fine: my $variance = variance(1,2,3,4,5); =item B Returns a L object. Arguments can be any of: an array ref, a list of numbers, or a blessed vector object. Pass a vector object to C to avoid recalculating the variance and mean if applicable (see C). =item B B Returns a L object. Arguments to C or C must be array ref or vector objects. There must be precisely two arguments (or none, setting the vectors to two empty ones), and they must be the same length. =item B B B Returns a L object. Arguments to C or C/C must be array ref or vector objects. There must be precisely two arguments (or none, setting the vectors to two empty ones), and they must be the same length. =item B B B Returns a L object. Arguments to C or C/C must be array ref or vector objects. There must be precisely two arguments (or none, setting the vectors to two empty ones), and they must be the same length. =item B Returns a L object. Argument must be a blessed vector object. See the section on L for more information on this. =item B B Returns two L objects. Arguments to this function should be two vector arguments. See the section on L for further information on this function. =back =head1 COMPUTED VECTORS Sometimes it will be handy to have a vector computed from another (or at least that updates based on the first). Consider the case of outliers: my @a = ( (1,2,3) x 7, 15 ); my @b = ( (1,2,3) x 7 ); my $v1 = vector(@a); my $v2 = vector(@b); my $v3 = computed($v1); $v3->set_filter(sub { my $m = mean($v1); my $s = stddev($v1); grep { abs($_-$m) <= $s } @_; }); This filter sets C<$v3> to always be equal to C<$v1> such that all the elements that differ from the mean by more than a standard deviation are removed. As such, C<"$v2" eq "$v3"> since C<15> is clearly an outlier by inspection. print "$v1\n"; print "$v3\n"; ... prints: [1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 15] [1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3] =head1 MISSING VALUES Something I get asked about quite a lot is, "can S::B handle missing values?" The answer used to be, "that really depends on your data set, use L," but I recently decided (5/29/09) that it was time to just go ahead and add this feature. Strictly speaking, the feature was already there. You simply need to add a couple filters to your data. See C for the test example. This is what people usually mean when they ask if S::B can "handle" missing data: my $v1 = vector(1,2,3,undef,4); my $v2 = vector(1,2,3,4, undef); my $v3 = computed($v1); my $v4 = computed($v2); $v3->set_filter(sub { my @v = $v2->query; map {$_[$_]} grep { defined $v[$_] and defined $_[$_] } 0 .. $#_; }); $v4->set_filter(sub { my @v = $v1->query; map {$_[$_]} grep { defined $v[$_] and defined $_[$_] } 0 .. $#_; }); print "$v1 $v2\n"; # prints: [1, 2, 3, _, 4] [1, 2, 3, 4, _] print "$v3 $v4\n"; # prints: [1, 2, 3] [1, 2, 3] But I've made it even simpler. Since this is such a common request, I have provided a helper function to build the filters automatically: my $v1 = vector(1,2,3,undef,4); my $v2 = vector(1,2,3,4, undef); my ($f1, $f2) = handle_missing_values($v1, $v2); print "$f1 $f2\n"; # prints: [1, 2, 3] [1, 2, 3] Note that in practice, you would still manipulate (insert, and shift) C<$v1> and C<$v2>, I the computed vectors. But for correlations and the like, you would use C<$f1> and C<$f2>. $v1->insert(5); $v2->insert(6); my $correlation = correlation($f1, $f2); You can still insert on C<$f1> and C<$f2>, but it updates the input vector rather than the computed one (which is just a filter handler). =head1 REUSE DETAILS Most of the objects have a variety of query functions that allow you to extract the objects used within. Although, the objects are smart enough to prevent needless duplication. That is, the following would test would pass: use Statistics::Basic qw(:all); my $v1 = vector(1,2,3,4,5); my $v2 = vector($v1); my $sd = stddev( $v1 ); my $v3 = $sd->query_vector; my $m1 = mean( $v1 ); my $m2 = $sd->query_mean; my $m3 = Statistics::Basic::Mean->new( $v1 ); my $v4 = $m3->query_vector; use Scalar::Util qw(refaddr); use Test; plan tests => 5; ok( refaddr($v1), refaddr($v2) ); ok( refaddr($v2), refaddr($v3) ); ok( refaddr($m1), refaddr($m2) ); ok( refaddr($m2), refaddr($m3) ); ok( refaddr($v3), refaddr($v4) ); # this is t/54_* in the distribution Also, note that the mean is only calculated once even though we've calculated a variance and a standard deviation above. Suppose you'd like a copy of the L object that the L object is using. All of the objects within should be accessible with query functions as follows. =head1 QUERY FUNCTIONS =over =item B This method exists in all of the objects. L is the only one that returns two values (alpha and beta) as a list. L returns either the list of elements in the vector, or reference to that array (depending on the context). All of the other C methods return a single number, the number the module purports to calculate. =item B Returns the L object used by L and L. =item B Returns the first L object used by L, L and L. =item B Returns the second L object used by L, and L. =item B Returns the L object used by L and L. =item B Returns the L object used by L. =item B Returns the first L object used by L. =item B Returns the L object used by any of the single vector modules. =item B Returns the first L object used by any of the two vector modules. =item B Returns the second L object used by any of the two vector modules. =item B L objects sometimes return L objects instead of numbers. When C is true, the mode is a vector, not a scalar. =item B L is meant for finding a line of best fit. This function can be used to find the C for a given C based on the calculated C<$beta> (slope) and C<$alpha> (y-offset). =item B L is meant for finding a line of best fit. This function can be used to find the C for a given C based on the calculated C<$beta> (slope) and C<$alpha> (y-offset). This function can produce divide-by-zero errors since it must divide by the slope to find the C value. (The slope should rarely be zero though, that's a vertical line and would represent very odd data points.) =back =head1 INSERT and SET FUNCTIONS These objects are all intended to be useful while processing long columns of data, like data you'd find in a database. =over =item B Vectors try to stay the same size when they accept new elements, FIFO style. my $v1 = vector(1,2,3); # a 3 touple $v1->insert(4); # still a 3 touple print "$v1\n"; # prints: [2, 3, 4] $v1->insert(7); # still a 3 touple print "$v1\n"; # prints: [3, 4, 7] All of the other L modules have this function too. The modules that track two vectors will need two arguments to insert though. my $mean = mean([1,2,3]); $mean->insert(4); print "mean: $mean\n"; # prints 3 ... (2+3+4)/3 my $correlation = correlation($mean->query_vector, $mean->query_vector->copy); print "correlation: $correlation\n"; # 1 $correlation->insert(3,4); print "correlation: $correlation\n"; # 0.5 Also, note that the underlying vectors keep track of recalculating automatically. my $v = vector(1,2,3); my $m = mean($v); my $s = stddev($v); The mean has not been calculated yet. print "$s; $m\n"; # 0.82; 2 The mean has been calculated once (even though the L uses it). $v->insert(4); print "$s; $m\n"; 0.82; 3 $m->insert(5); print "$s; $m\n"; 0.82; 4 $s->insert(6); print "$s; $m\n"; 0.82; 5 The mean has been calculated thrice more and only thrice more. =item B B You can grow the vectors instead of sliding them (FIFO). For this, use C (or C, same thing). my $v = vector(1,2,3); my $m = mean($v); my $s = stddev($v); $v->append(4); print "$s; $m\n"; 1.12; 2.5 $m->append(5); print "$s; $m\n"; 1.41; 3 $s->append(6); print "$s; $m\n"; 1.71; 1.71 print "$v\n"; # [1, 2, 3, 4, 5, 6] print "$s\n"; # 1.71 Of course, with a correlation, or a covariance, it'd look more like this: my $c = correlation([1,2,3], [3,4,5]); $c->append(7,7); print "c=$c\n"; # c=0.98 =item B This allows you to set the vector to a known state. It takes either array ref or vector objects. my $v1 = vector(1,2,3); my $v2 = $v1->copy; $v2->set_vector([4,5,6]); my $m = mean(); $m->set_vector([1,2,3]); $m->set_vector($v2); my $c = correlation(); $c->set_vector($v1,$v2); $c->set_vector([1,2,3], [4,5,6]); =item B This sets the size of the vector. When the vector is made bigger, the vector is filled to the new length with leading zeros (i.e., they are the first to be kicked out after new Cs. my $v = vector(1,2,3); $v->set_size(7); print "$v\n"; # [0, 0, 0, 0, 1, 2, 3] my $m = mean(); $m->set_size(7); print "", $m->query_vector, "\n"; # [0, 0, 0, 0, 0, 0, 0] my $c = correlation([3],[3]); $c->set_size(7); print "", $c->query_vector1, "\n"; print "", $c->query_vector2, "\n"; # [0, 0, 0, 0, 0, 0, 3] # [0, 0, 0, 0, 0, 0, 3] =back =head1 OPTIONS Each of the following options can be specified on package import like this. use Statistics::Basic qw(unbias=0); # start with unbias disabled use Statistics::Basic qw(unbias=1); # start with unbias enabled When specified on import, each option has certain defaults. use Statistics::Basic qw(unbias); # start with unbias enabled use Statistics::Basic qw(nofill); # start with nofill enabled use Statistics::Basic qw(toler); # start with toler disabled use Statistics::Basic qw(ipres); # start with ipres=2 Additionally, with the exception of L, they can all be accessed via package variables of the same name in all upper case. Example: # code code code $Statistics::Basic::UNBIAS = 0; # turn UNBIAS off # code code code $Statistics::Basic::UNBIAS = 1; # turn it back on # code code code { local $Statistics::Basic::DEBUG_STATS_B = 1; # debug, this block only } Special caveat: L can in fact be changed via the package var (e.g., C<$Statistics::Basic::TOLER=0.0001>). But, for speed reasons, it must be L before any other packages are imported or it will not actually do anything when changed. =over 4 =item B This module uses the B definition of variance. If you wish to use the I, B definition, then set the C<$Statistics::Basic::UNBIAS> true (possibly with C). This can be changed at any time with the package variable or at compile time. This feature was requested by C<< Robert McGehee >>. [NOTE 2008-11-06: L, this can also be called "B" vs "B" and is indeed fully addressed right here!] =item B C defaults to 2. It is passed to L as the second argument to L during string interpolation (see: L). =item B When set, C<$Statistics::Basic::TOLER> (which is not enabled by default), instructs the stats objects to test true when I some tolerable range, pretty much like this: sub is_equal { return abs($_[0]-$_[1])<$Statistics::Basic::TOLER if defined($Statistics::Basic::TOLER) return $_[0] == $_[1] } For performance reasons, this must be defined before the import of any other L modules or the modules will fail to overload the C<==> operator. C<$Statistics::Basic::TOLER> totally disabled: use Statistics::Basic qw(:all toler); C<$Statistics::Basic::TOLER> disabled, but changeable: use Statistics::Basic qw(:all toler=0); $Statistics::Basic::TOLER = 0.000_001; You can I the tolerance at runtime, but it must be set (or unset) at compile time before the packages load. =item B Normally when you set the size of a vector it automatically fills with zeros on the first-out side of the vector. You can disable the autofilling with this option. It can be changed at any time. =item B Enable debugging with C or disable a specific level (including C<0> to disable) with C. This is also accessible at runtime using C<$Statistics::Basic::DEBUG_STATS_B> and can be switched on and off at any time. =item B Normally the defaults for these options can be changed in the environment of the program. Example: UNBIAS=1 perl ./myprog.pl This does the same thing as C<$Statistics::Basic::UNBIAS=1> or C unless you disable the C<%ENV> checking with this option. use Statistics::Basic qw(ignore_env); =back =head1 ENVIRONMENT VARIABLES You can change the defaults (assuming L is not used) from your bash prompt. Example: DEBUG_STATS_B=1 perl ./myprog.pl =over 4 =item B<$ENV{DEBUG_STATS_B}> Sets the default value of L. =item B<$ENV{UNBIAS}> Sets the default value of L. =item B<$ENV{NOFILL}> Sets the default value of L. =item B<$ENV{IPRES}> Sets the default value of L. =item B<$ENV{TOLER}> Sets the default value of L. =back =head1 OVERLOADS All of the objects are true in numeric context. All of the objects print useful strings when evaluated as a string. Most of the objects evaluate usefully as numbers, although L objects, L objects, and L objects do not -- they instead raise an error. =head1 Author's note on Statistics::Descriptive I've been asked a couple times now why I don't link to L in my see also section. As a rule, I only link to packages there that I think are related or that I actually used in the package construction. I've never personally used Descriptive, but it surely seems to do quite a lot more. In a sense, this package really doesn't do statistics, not like a scientist would think about it anyway. So I always figured people could find their own way to Descriptive anyway. The one thing this package does do, that I don't think Descriptive does (correct me if I'm wrong) is time difference computations. If there are say, 200 things in the mean object, then after inserting (using this package) there'll still be 200 things, allowing the computation of a moving average, moving stddev, moving correlation, etc. You might argue that this is rarely needed, but it is really the only time I need to compute these things. while( $data = $fetch_sth->fetchrow_arrayref ) { $mean->insert($data); $moving_avg_sth->execute(0 + $mean); } Since I opened the topic I'd also like to mention that I find this package easier to use. That is a matter of taste and since I wrote this, you might say I'm a little biased. Your mileage may vary. =head1 AUTHOR Paul Miller C<< >> I am using this software in my own projects... If you find bugs, please please please let me know. :) Actually, let me know if you find it handy at all. Half the fun of releasing this stuff is knowing that people use it. =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL version 2. =head1 SEE ALSO perl(1), L, L, L, L, L, L, L, L, L, L, L, L, L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/0000750000175000017500000000000011707262605020622 5ustar jetterojetteroStatistics-Basic-1.6607/lib/Statistics/Basic/Mean.pod0000644000175000017500000000344411707243041022211 0ustar jetterojettero=head1 NAME Statistics::Basic::Mean - find the mean of a list =head1 SYNOPSIS Invoke it this way: my $avg = mean(1,2,3); Or this way: my $v1 = vector(1,2,3); my $avg = avg($v1); And then either query the values or print them like so: print "The mean of $v1: $avg\n"; my $mq = $avg->query; my $m0 = 0+$avg; Create a 20 point moving average like so: use Statistics::Basic qw(:all nofill); my $sth = $dbh->prepare("select col1 from data where something"); my $len = 20; my $avg = mean()->set_size($len); $sth->execute or die $dbh->errstr; $sth->bind_columns( my $val ) or die $dbh->errstr; while( $sth->fetch ) { $avg->insert( $val ); if( defined( my $m = $avg->query ) ) { print "Mean: $m\n"; } # This would also work: # print "Mean: $avg\n" if $avg->query_filled; } =head1 METHODS =over 4 =item B The constructor takes a single array ref or a single L as arguments. It returns a L object. Note: normally you'd use the L constructor, rather than building these by hand using C. =item B<_OVB::import()> This module also inherits all the overloads and methods from L. =back =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the calculation or the value of the computation in numeric context. In boolean context, this object is always true (even when empty). =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/_OneVectorBase.pod0000644000175000017500000000471011707243042024165 0ustar jetterojettero=head1 NAME Statistics::Basic::_OneVectorBase - base class objects like Mean =head1 METHODS =over 4 =item B Query the value of the object. It will return the undefined value until there's something to calculate (or until the vector is full when L is in effect). =item B Insert new values into the vector. $object_instance->insert( 4, 3 ); # insert a 3 and a 4 This function returns the object itself, for chaining purposes. =item B B The growing insert inserts new elements, growing the max size of the vector to accommodate the new elements (if necessary). $object_instance->ginsert( 4, 3 ); # append a 3 and a 4 This function returns the object itself, for chaining purposes. =item B The current size of the vector -- regardless of its max size (as set by L). =item B Returns the L object used by the computational object. =item B Set the maximum size for the underlying L object. This function requires one arguments. Unless L is set, the vector will be filled with C<0>s (assuming the vector wouldn't otherwise be full) on the oldest side of the vector (so an insert will push off one of the filled-zeros). This function returns the object itself, for chaining purposes. =item B Given a vector or array ref, this will set the contents (and size) of the vector used for the object computations. This function returns the object itself, for chaining purposes. =back =head1 OVERLOADS This class provides overloads. If evaluated as a string, it will attempt to print a pretty value for the object (or C, see L above). the resulting string can be tuned, in terms of precision, see L for further information. If evaluated as a number, it will try to return the raw result of L, possibly turning the resulting C (if applicable) into a C<0> in the process -- note that Perl does this C<0>-izing, not the overload. The C and C<==> operators are also overloaded, trying to do the right thing. Also see L for further information. =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/LeastSquareFit.pod0000644000175000017500000001042511707243041024222 0ustar jetterojettero=head1 NAME Statistics::Basic::LeastSquareFit - find the least square fit for two lists =head1 SYNOPSIS A machine to calculate the Least Square Fit of given vectors x and y. The module returns the alpha and beta filling this formula: $y = $beta * $x + $alpha for a given set of I and I co-ordinate pairs. Say you have the set of Cartesian coordinates: my @points = ( [1,1], [2,2], [3,3], [4,4] ); The simplest way to find the LSF is as follows: my $lsf = lsf()->set_size(int @points); $lsf->insert(@$_) for @points; Or this way: my $xv = vector( map {$_->[0]} @points ); my $yv = vector( map {$_->[1]} @points ); my $lsf = lsf($xv, $yv); And then either query the values or print them like so: print "The LSF for $xv and $yv: $lsf\n"; my ($yint, $slope) = my ($alpha, $beta) = $lsf->query; L is meant for finding a line of best fit. C<$beta> is the slope of the line and C<$alpha> is the y-offset. Suppose you want to draw the line. Use these to calculate the C for a given C or vice versa: my $y = $lsf->y_given_x( 7 ); my $x = $lsf->x_given_y( 7 ); (Note that C can sometimes produce a divide-by-zero error since it has to divide by the C<$beta>.) Create a 20 point "moving" L like so: use Statistics::Basic qw(:all nofill); my $sth = $dbh->prepare("select x,y from points where something"); my $len = 20; my $lsf = lsf()->set_size($len); $sth->execute or die $dbh->errstr; $sth->bind_columns( my ($x, $y) ) or die $dbh->errstr; my $count = $len; while( $sth->fetch ) { $lsf->insert( $x, $y ); if( defined( my ($yint, $slope) = $lsf->query ) { print "LSF: y= $slope*x + $yint\n"; } # This would also work: # print "$lsf\n" if $lsf->query_filled; } =head1 METHODS This list of methods skips the methods inherited from L (things like L, and L). =over 4 =item B Create a new L object. This function takes two arguments -- which can either be arrayrefs or L objects. This function is called when the L shortcut-function is called. =item B L is meant for finding a line of best fit. C<$beta> is the slope of the line and C<$alpha> is the y-offset. my ($alpha, $beta) = $lsf->query; =item B Automatically calculate the y-value on the line for a given x-value. my $y = $lsf->y_given_x( 7 ); =item B Automatically calculate the x-value on the line for a given y-value. my $x = $lsf->x_given_y( 7 ); C can sometimes produce a divide-by-zero error since it has to divide by the C<$beta>. This might be helpful: if( defined( my $x = eval { $lsf->x_given_y(7) } ) ) { warn "there is no x value for 7"; } else { print "x (given y=7): $x\n"; } =item B Return the L for the first vector used in the computation of alpha and beta. =item B Return the L object for the second vector used in the computation of alpha and beta. =item B Returns the L object for the first vector used in the computation of alpha and beta. =item B Returns the L object for the first vector used in the computation of alpha and beta. =item B Returns the L object used in the computation of alpha and beta. =back =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the calculation, but raises an error in numeric context. In boolean context, this object is always true (even when empty). =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/Vector.pod0000644000175000017500000001054011707243042022567 0ustar jetterojettero=head1 NAME Statistics::Basic::Vector - a class for handling lists of numbers =head1 SYNOPSIS Invoke it this way: my $vector = vector(1,2,3); my $same_vector = vector($vector); my $different = $vector->copy; This module tracks which of the other L modules I it. That's it's primary purpose. Although, it does also have overloads to print the vectors in a pretty fashion. print "$vector\n"; # pretty printed =head1 METHODS =over 4 =item B The constructor can take a single array ref or a single L as its argument. It can also take a list of values. It returns a L object. If given a vector object argument, this function will return the argument rather than creating a new vector. This mainly used by the other L modules to try to prevent duplicate calculations. A vector's max size is set to the size of the argument or list on initialization. Note: normally you'd use the L constructor, rather than building these by hand using C. =item B Creates a new vector object with the same contents and size as this one and returns it. my $v1 = vector(3,7,9); my $v2 = $v1->copy(); # $v2 is a new object, separate vector my $v3 = vector($v1); # $v3 is the same object as $v1 =item B Insert new values into the vector. If the vector was already full (see L), this will also shift oldest elements from the vector to compensate. $vector->insert( 4, 3 ); # insert a 3 and a 4 This function returns the object itself, for chaining purposes. =item B B Insert new values into the vector. If the vector was already full (see L), these functions will grow the size of the vector to accommodate the new values, rather than shifting things. C does the same thing. $vector->append( 4, 3 ); # append a 3 and a 4 This function returns the object itself, for chaining purposes. =item B C returns the contents of the vector either as a list or as an arrayref. my @copy_of_contents = $vector->query; my $reference_to_contents = $vector->query; Note that changing the C<$reference_to_contents> will not usefully affect the contents of the vector itself, but it will adversely affect any computations based on the vector. If you need to change the contents of a vector in a special way, use a L object instead. Keeping C<$reference_to_contents> available long term should work acceptably (since it refers to the vector contents itself). =item B Returns true when the vector is the same size as the max size set by L. This function isn't useful unless operating under the effects of the L setting. =item B Returns the current number of elements in the vector object (not the size set with L). This is almost never false unless you're using the L setting. =item B Sets the max size of the vector. my $v1 = vector(1,2,3); $v1->set_size(7); # [0, 0, 0, 0, 1, 2, 3] Unless L is set, the vector will be filled with C<0>s (assuming the vector wouldn't otherwise be full) on the oldest side of the vector (so an insert will push off one of the filled-zeros). This function returns the object itself, for chaining purposes. my $v1 = vector(2 .. 5)->set_size(5); # [0, 2, 3, 4, 5] =item B Given a vector or array ref, this will set the contents (and size) of the input vector to match the argument. If given a vector object argument, this will make the two vectors match, while still remaining separate objects. my $v1 = vector(3,7,9); my $v2 = vector()->set_vector($v1); my $v3 = vector($v1); # $v3 is the same object as $v1 This function returns the object itself, for chaining purposes. =back =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the vector and raises errors in numeric context. In boolean context, this object is always true (even when empty). =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/ComputedVector.pod0000644000175000017500000001167111707243041024275 0ustar jetterojettero=head1 NAME Statistics::Basic::ComputedVector - a class for computing filtered vectors =head1 SYNOPSIS Invoke it this way: my $vector = vector(1,2,3); my $computed = computed($vector)->set_filter(sub{ # NOTE: only interested in even numbers: grep { !($_ % 2) } @_ }); # nearly the same, opposite order: my $computed = computed(1,2,3)->set_filter(sub {map{$_+1}@_}); my $vector = $computed->query_vector; =head1 METHODS =over 4 =item B The constructor takes a single array ref or a single L as its argument. It returns a L object. If passed arguments other than L objects, the constructor will built an appropriate vector object -- which can be queried with L Note: normally you'd use the L constructor, rather than building these by hand using C. =item B Creates a new computed vector object referring to the same source vector and using the same filter as this one. my $v1 = vector(1,2,3); my $c1 = computed($v1); $c1->set_filter(my $s = sub {}); my $copy1 = computed($v1); $copy1->set_filter($s); my $copy2 = $c1->copy; # just like $c2, but in one step To instead create a filtered version of a filtered vector, choose this form: my $v1 = vector(1,2,3); my $c1 = computed($v1); $c1->set_filter(sub {}); my $c2 = computed($c1); $c2->set_filter(sub {}); =item B Insert new values into the input vector. If the vector was already full (see L), this will also shift oldest elements from the input vector to compensate. $computed->insert( 4, 3 ); # insert a 3 and a 4 Note that continuing from the L example, this would certainly insert a 4 and a 3 into the input vector, but the 3 wouldn't be returned from a L because it is odd. This function returns the object itself, for chaining purposes. =item B B Insert new values into the input vector. If the vector was already full (see L), these functions will grow the size of the input vector to accommodate the new values, rather than shifting things. $computed->append( 4, 3 ); # append a 3 and a 4 Note that continuing from the L example, this would certainly insert a 4 and a 3 into the input vector, but the 3 wouldn't be returned from a L because it is odd. This function returns the object itself, for chaining purposes. =item B C returns the contents of the computed vector (after filtering) either as a list or as an arrayref. my @copy_of_contents = $computed->query; my $reference_to_contents = $computed->query; Note that changing the C<$reference_to_contents> will not usefully affect the contents of the vector itself, but it will adversely affect any computations based on the vector. If you need to change the contents of a vector in a special way, use another L object instead. Keeping C<$reference_to_contents> available long term should work acceptably (since it refers to the vector contents itself). =item B Return the input L object. =item B This returns true when the input vector is full (see L). This is of questionable usefulness on computed vectors, but is provided for completeness (and internal package consistency). =item B Return the current size of the computed vector. =item B Set the filtering for the computed vector. This function takes a single coderef argument -- all other arguments will be ignored. The elements of the input vector are passed to your filter coderef in C<@_> and your ref should return the calculated elements of the computed vector as a list. my $vec = vector(1,2,3); my $pow = computed($vec); $pow->set_filter(sub { return map { $_ ** 2 } @_ }) If you need to call more than one filter function, concatenate them together using map or an anonymous sub. $pow->set_filter(sub { return f1(f2(f3(f4(@_)))) }); This function returns the object itself, for chaining purposes. =item B Set the size of the input vector (not the computed vector, that would make little sense). This function returns the object itself, for chaining purposes. =item B Set the contents of the input vector (not the computed one). This function returns the object itself, for chaining purposes. =back =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the vector and raises errors in numeric context. In boolean context, this object is always true (even when empty). =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/Variance.pod0000644000175000017500000000423711707243042023063 0ustar jetterojettero=head1 NAME Statistics::Basic::Variance - find the variance of a list =head1 SYNOPSIS Invoke it this way: my $variance = variance(1,2,3); Or this way: my $v1 = vector(1,2,3); my $var = var($v1); And then either query the values or print them like so: print "The variance of $v1: $variance\n"; my $vq = $var->query; my $v0 = 0+$var; Create a 20 point "moving" variance like so: use Statistics::Basic qw(:all nofill); my $sth = $dbh->prepare("select col1 from data where something"); my $len = 20; my $var = var()->set_size($len); $sth->execute or die $dbh->errstr; $sth->bind_columns( my $val ) or die $dbh->errstr; while( $sth->fetch ) { $var->insert( $val ); if( defined( my $v = $var->query ) ) { print "Variance: $v\n"; } # This would also work: # print "Variance: $v\n" if $var->query_filled; } =head1 METHODS =over 4 =item B The constructor takes a list of values, a single array ref, or a single L as arguments. It returns a L object. Note: normally you'd use the L constructor, rather than building these by hand using C. =item B Returns the L object used in the variance computation. =item B<_OVB::import()> This module also inherits all the overloads and methods from L. =back =head1 AUTHOR Paul Miller C<< >> I am using this software in my own projects... If you find bugs, please please please let me know. :) Actually, let me know if you find it handy at all. Half the fun of releasing this stuff is knowing that people use it. =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the calculation or the value of the computation in numeric context. In boolean context, this object is always true (even when empty). =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/Correlation.pod0000644000175000017500000000513311707243041023607 0ustar jetterojettero=head1 NAME Statistics::Basic::Correlation - find the correlation between two lists =head1 SYNOPSIS Invoke it this way: my $correlation = correlation( [1,2,3], [1,2,3] ); Or this way: my $v1 = vector(1,2,3); my $v2 = vector(1,2,3); my $cor = corr($v1,$v2); And then either query the values or print them like so: print "The correlation between $v1 and $v2: $correlation\n"; my $cq = $cor->query; my $c0 = 0+$correlation; Create a 20 point "moving" correlation like so: use Statistics::Basic qw(:all nofill); my $sth = $dbh->prepare("select col1,col2 from data where something"); my $len = 20; my $cor = corr()->set_size($len); $sth->execute or die $dbh->errstr; $sth->bind_columns( my ($lhs, $rhs) ) or die $dbh->errstr; my $count = $len; while( $sth->fetch ) { $cor->insert( $lhs, $rhs ); if( defined( my $c = $cor->query ) ) { print "Correlation: $c\n"; } # This would also work: # print "Correlation: $cor\n" if $cor->query_filled; } =head1 METHODS This list of methods skips the methods inherited from L (things like L, L, and L). =over 4 =item B Create a new L object. This function takes two arguments -- which can either be arrayrefs or L objects. This function is called when the L shortcut-function is called. =item B Returns the L object used to calculate the correlation. =item B Return the L for the first vector. =item B Return the L object for the second vector. =item B Returns the L object for the first vector. =item B Returns the L object for the second vector. =back =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the calculation or the value of the computation in numeric context. In boolean context, this object is always true (even when empty). =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/Mode.pod0000644000175000017500000000525511707243042022220 0ustar jetterojettero=head1 NAME Statistics::Basic::Mode - find the mode of a list =head1 SYNOPSIS Invoke it this way: my $mode = mode(1,2,3,3); Or this way: my $v1 = vector(1,2,3,3); my $mod = mode($v1); And then either query the values or print them like so: print "The mod of $v1: $mod\n"; my $mq = $mod->query; my $m0 = 0+$mod; # this will croak occasionally, see below The mode of an array is not necessarily a scalar. The mode of this vector is a vector: my $mod = mode(1,2,3); my $v2 = $mod->query; print "hrm, there's three elements in this mode: $mod\n" if $mod->is_multimodal; Create a 20 point "moving" mode like so: use Statistics::Basic qw(:all nofill); my $sth = $dbh->prepare("select col1 from data where something"); my $len = 20; my $mod = mode()->set_size($len); $sth->execute or die $dbh->errstr; $sth->bind_columns( my $val ) or die $dbh->errstr; while( $sth->fetch ) { $mod->insert( $val ); if( defined( my $m = $mod->query ) ) { print "Mode: $m\n"; } print "Mode: $mod\n" if $mod->query_filled; } =head1 METHODS =over 4 =item B The constructor takes a list of values, a single array ref, or a single L as arguments. It returns a L object. Note: normally you'd use the L constructor, rather than building these by hand using C. =item B L objects sometimes return L objects instead of numbers. When C is true, the mode is a vector, not a scalar. =item B<_OVB::import()> This module also inherits all the overloads and methods from L. =back =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the calculation or the value of the computation in numeric context. In boolean context, this object is always true (even when empty). If evaluated as a string, L will try to format a number (like any other L object), but if the object L, it will instead return a L for stringification. $x = mode(1,2,3); $y = mode(1,2,2); print "$x, $y\n"; # prints: [1, 2, 3], 2 If evaluated as a number, a L will raise an error when the object L. =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/Median.pod0000644000175000017500000000345411707243041022527 0ustar jetterojettero=head1 NAME Statistics::Basic::Median - find the median of a list =head1 SYNOPSIS Invoke it this way: my $median = median(1,2,3); Or this way: my $v1 = vector(1,2,3); my $med = median($v1); And then either query the values or print them like so: print "The median of $v1: $med\n"; my $mq = $med->query; my $m0 = 0+$med; Create a 20 point "moving" median like so: use Statistics::Basic qw(:all nofill); my $sth = $dbh->prepare("select col1 from data where something"); my $len = 20; my $med = median()->set_size($len); $sth->execute or die $dbh->errstr; $sth->bind_columns( my $val ) or die $dbh->errstr; while( $sth->fetch ) { $med->insert( $val ); if( defined( $m = $med->query ) ) { print "Median: $m\n"; } # This would also work: # print "Median: $med\n" if $med->query_filled; } =head1 METHODS =over 4 =item B The constructor takes a single array ref or a single L as arguments. It returns a L object. Note: normally you'd use the L constructor, rather than building these by hand using C. =item B<_OVB::import()> This module also inherits all the overloads and methods from L. =back =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the calculation or the value of the computation in numeric context. In boolean context, this object is always true (even when empty). =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/Covariance.pod0000644000175000017500000000472711707243041023410 0ustar jetterojettero=head1 NAME Statistics::Basic::Covariance - find the covariance between two lists =head1 SYNOPSIS Invoke it this way: my $covariance = covariance( [1,2,3], [1,2,3] ); Or this way: my $v1 = vector(1,2,3); my $v2 = vector(1,2,3); my $cov = cov($v1,$v2); And then either query the values or print them like so: print "The covariance between $v1 and $v2: $covariance\n"; my $cq = $cov->query; my $c0 = 0+$cov; Create a 20 point "moving" covariance like so: use Statistics::Basic qw(:all nofill); my $sth = $dbh->prepare("select col1,col2 from data where something"); my $len = 20; my $cov = cov(); $cov->set_size($len); $sth->execute or die $dbh->errstr; $sth->bind_columns( my ($lhs, $rhs) ) or die $dbh->errstr; my $count = $len; while( $sth->fetch ) { $cov->insert( $lhs, $rhs ); if( defined( my $c = $cov->query ) ) { print "Covariance: $c\n"; } # This would also work: # print "Covariance: $cov\n" if $cov->query_filled; } =head1 METHODS This list of methods skips the methods inherited from L (things like L, L, and L). =over 4 =item B Create a new L object. This function takes two arguments -- which can either be arrayrefs or L objects. This function is called when the L shortcut-function is called. =item B Return the L for the first vector. =item B Return the L object for the second vector. =item B Returns the L object for the first vector. =item B Returns the L object for the second vector. =back =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the calculation or the value of the computation in numeric context. In boolean context, this object is always true (even when empty). =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/StdDev.pod0000644000175000017500000000423111707243042022516 0ustar jetterojettero=head1 NAME Statistics::Basic::StdDev - find the standard deviation of a list =head1 SYNOPSIS Invoke it this way: my $stddev = stddev(1,2,3); Or this way: my $v1 = vector(1,2,3); my $std = stddev($v1); And then either query the values or print them like so: print "The stddev of $v1: $std\n"; my $sq = $std->query; my $s0 = 0+$std; Create a 20 point "moving" stddev like so: use Statistics::Basic qw(:all nofill); my $sth = $dbh->prepare("select col1 from data where something"); my $len = 20; my $std = stddev()->set_size($len); $sth->execute or die $dbh->errstr; $sth->bind_columns( my $val ) or die $dbh->errstr; while( $sth->fetch ) { $std->insert( $val ); if( defined( my $s = $std->query ) ) { print "StdDev: $s\n"; } # This would also work: # print "StdDev: $s\n" $std->query_filled; } =head1 METHODS =over 4 =item B The constructor takes a list of values, a single array ref, or a single L as arguments. It returns a L object. Note: normally you'd use the L constructor, rather than building these by hand using C. =item B Returns the L object used in the standard deviation computation. =item B<_OVB::import()> This module also inherits all the overloads and methods from L. =back =head1 OVERLOADS This object is overloaded. It tries to return an appropriate string for the calculation or the value of the computation in numeric context. In boolean context, this object is always true (even when empty). =head1 AUTHOR Paul Miller C<< >> I am using this software in my own projects... If you find bugs, please please please let me know. :) Actually, let me know if you find it handy at all. Half the fun of releasing this stuff is knowing that people use it. =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L, L =cut Statistics-Basic-1.6607/lib/Statistics/Basic/_TwoVectorBase.pod0000644000175000017500000000464511707243042024224 0ustar jetterojettero=head1 NAME Statistics::Basic::_TwoVectorBase - base class objects like Correlation =head1 METHODS =over 4 =item B Query the value of the object. It will return the undefined value until there's something to calculate. =item B Insert two new new values into the vectors. This function must be given precisely two arguments and probably shouldn't be undefined values in most cases. # insert a 4 in one vector and a 3 in the other $object_instance->insert( 4, 3 ); =item B B The growing insert inserts new elements, growing the max size of the vector to accommodate the new elements (if necessary). This function must be given precisely two arguments and probably shouldn't be undefined values in most cases. # append a 4 in one vector and a 3 in the other $object_instance->ginsert( 4, 3 ); =item B The current size of the vectors -- regardless of their max size (as set by L). This function returns a list, i.e.: my @s = $obj->query_size; # two values my $s = $obj->query_size; # the right hand value of the list =item B Set the maximum size for the underlying L objects. This function requires two arguments. =item B Set the vector objects used to calculate the object's value. This function takes two arguments -- which can either be arrayrefs or L objects. They must have the same number of elements. my $v1 = vector my $v2 = $v1->copy; $example_correlation->set_vector($v1, $v2); =back =head1 OVERLOADS This class provides overloads. If evaluated as a string, it will attempt to print a pretty value for the object (or C, see L above). the resulting string can be tuned, in terms of precision, see L for further information. If evaluated as a number, it will try to return the raw result of L, possibly turning the resulting C (if applicable) into a C<0> in the process -- note that Perl does this C<0>-izing, not the overload. The C and C<==> operators are also overloaded, trying to do the right thing. Also see L for further information. =head1 AUTHOR Paul Miller C<< >> =head1 COPYRIGHT Copyright 2012 Paul Miller -- Licensed under the LGPL =head1 SEE ALSO perl(1), L, L =cut Statistics-Basic-1.6607/MANIFEST0000644000175000017500000000325211707262606016042 0ustar jetterojettero.perlcriticrc Basic.pm Basic/ComputedVector.pm Basic/Correlation.pm Basic/Covariance.pm Basic/LeastSquareFit.pm Basic/Mean.pm Basic/Median.pm Basic/Mode.pm Basic/StdDev.pm Basic/Variance.pm Basic/Vector.pm Basic/_OneVectorBase.pm Basic/_TwoVectorBase.pm Changes MANIFEST Makefile.PL README lib/Statistics/Basic.pod lib/Statistics/Basic/ComputedVector.pod lib/Statistics/Basic/Correlation.pod lib/Statistics/Basic/Covariance.pod lib/Statistics/Basic/LeastSquareFit.pod lib/Statistics/Basic/Mean.pod lib/Statistics/Basic/Median.pod lib/Statistics/Basic/Mode.pod lib/Statistics/Basic/StdDev.pod lib/Statistics/Basic/Variance.pod lib/Statistics/Basic/Vector.pod lib/Statistics/Basic/_OneVectorBase.pod lib/Statistics/Basic/_TwoVectorBase.pod t/05_load_them.t t/07_vector.t t/08_cvec.t t/08_filter_outliers.t t/09_test_importer_vars_debug.t t/09_test_importer_vars_debug0.t t/09_test_importer_vars_debug1.t t/09_test_importer_vars_ipres.t t/09_test_importer_vars_ipres1.t t/09_test_importer_vars_ipres2.t t/09_test_importer_vars_nofill.t t/09_test_importer_vars_nofill0.t t/09_test_importer_vars_nofill1.t t/09_test_importer_vars_toler.t t/09_test_importer_vars_toler1.t t/10_mean.t t/10_median.t t/10_mode.t t/10_moving_average.t t/15_covariance.t t/15_variance.t t/17_stddev.t t/19_combo.t t/20_LSF.t t/20_correlation.t t/25_correlate_computed.t t/30_empty_constructor_tests.t t/53_co_persistance.t t/53_persistance.t t/54_doc_example.t t/60_bigfloats.t t/75_filtered_missings.t t/75_missing_correlated.t t/critic.t t/pod.t t/pod_coverage.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Statistics-Basic-1.6607/META.json0000640000175000017500000000215711707262606016331 0ustar jetterojettero{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150", "keywords" : [ "stats", "statistics", "mean", "average", "correlation" ], "license" : [ "open_source" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Statistics-Basic", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "runtime" : { "requires" : { "Number::Format" : "1.42", "Scalar::Util" : 0, "perl" : "5.006" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "http://github.com/jettero/statistics--basic" } }, "version" : "1.6607" } Statistics-Basic-1.6607/README0000644000175000017500000000036111162234137015560 0ustar jetterojettero use Statistics::Basic qw(:all); my $median = median( 1,2,3 ); my $mean = mean( [1,2,3]); # array refs are ok too my $variance = variance( 1,2,3 ); my $stddev = stddev( 1,2,3 ); my $correlation = correlation( [1 .. 3], [1 .. 3] ); Statistics-Basic-1.6607/META.yml0000640000175000017500000000116711707262606016161 0ustar jetterojettero--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150' keywords: - stats - statistics - mean - average - correlation license: open_source meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Statistics-Basic no_index: directory: - t - inc requires: Number::Format: 1.42 Scalar::Util: 0 perl: 5.006 resources: repository: http://github.com/jettero/statistics--basic version: 1.6607 Statistics-Basic-1.6607/Basic.pm0000644000175000017500000000773411707262466016305 0ustar jetterojettero package Statistics::Basic; use strict; use warnings; use Carp; use Number::Format; our $VERSION = '1.6607'; our $fmt = new Number::Format; our( $NOFILL, $DEBUG, $IPRES, $TOLER, $UNBIAS ); BEGIN { $NOFILL = exists($ENV{NOFILL}) ? $ENV{NOFILL} : 0; $DEBUG = exists($ENV{DEBUG_STATS_B}) ? $ENV{DEBUG_STATS_B} : 0; $IPRES = exists($ENV{IPRES}) ? $ENV{IPRES} : 2; $TOLER = $ENV{TOLER} if exists $ENV{TOLER}; } use base 'Exporter'; our @EXPORT_OK = (qw( vector computed mean average avg median mode variance var stddev covariance cov correlation cor corr leastsquarefit LSF lsf handle_missing_values handle_missing )); our %EXPORT_TAGS = ( all => \@EXPORT_OK ); sub import { my @special = (); @_ = grep { m/^(ignore_env|nofill|debug|ipres|toler|unbias)(?:=([\d\.\-_]+))?\z/i ? do {push @special, [lc($1), $2]; 0} : 1 } @_; if( grep {$_->[0] =~ m/ignore_env/} @special ) { delete $ENV{TOLER}; $NOFILL = 0; $DEBUG = 0; $IPRES = 2; $TOLER = undef; $UNBIAS = 0; } for( grep {$_->[0] !~ m/ignore_env/} @special ) { my ($k, $v) = @$_; $v = eval $v if defined $v; ## no critic if( lc($k) eq "ipres" ) { $v = 2 unless defined($v); croak "bad ipres value ($v)" unless $v >= 0; $IPRES = $v; } elsif( lc($k) eq "toler" ) { if( defined $v ) { croak "bad toler value($v)" unless $v >= 0; $TOLER = $v; } else { $TOLER = undef; } } else { no strict 'refs'; ## no critic ${uc($k)} = defined($v) ? $v : 1; ## no critic } } my $pull = q { use Statistics::Basic::Covariance; use Statistics::Basic::Correlation; use Statistics::Basic::LeastSquareFit; use Statistics::Basic::Mean; use Statistics::Basic::Median; use Statistics::Basic::Mode; use Statistics::Basic::StdDev; use Statistics::Basic::Variance; use Statistics::Basic::Vector; use Statistics::Basic::ComputedVector; 1; }; eval $pull or die "problem loading base modules: $@"; ## no critic return __PACKAGE__->export_to_level(1, @_); } sub computed { my $r = eval { Statistics::Basic::ComputedVector->new(@_) } or croak $@; return $r } sub vector { my $r = eval { Statistics::Basic::Vector->new(@_) } or croak $@; return $r } sub mean { my $r = eval { Statistics::Basic::Mean->new(@_) } or croak $@; return $r } sub median { my $r = eval { Statistics::Basic::Median->new(@_) } or croak $@; return $r } sub mode { my $r = eval { Statistics::Basic::Mode->new(@_) } or croak $@; return $r } sub variance { my $r = eval { Statistics::Basic::Variance->new(@_) } or croak $@; return $r } sub stddev { my $r = eval { Statistics::Basic::StdDev->new(@_) } or croak $@; return $r } sub covariance { my $r = eval { Statistics::Basic::Covariance->new( $_[0], $_[1] ) } or croak $@; return $r } sub correlation { my $r = eval { Statistics::Basic::Correlation->new( $_[0], $_[1] ) } or croak $@; return $r } sub leastsquarefit { my $r = eval { Statistics::Basic::LeastSquareFit->new( $_[0], $_[1] ) } or croak $@; return $r } sub handle_missing_values { my ($v1,$v2) = @_; my $v3 = eval { computed($v1) } or croak $@; my $v4 = eval { computed($v2) } or croak $@; $v3->set_filter(sub { my @v = $v2->query; map {$_[$_]} grep { defined $v[$_] and defined $_[$_] } 0 .. $#_; }); $v4->set_filter(sub { my @v = $v1->query; map {$_[$_]} grep { defined $v[$_] and defined $_[$_] } 0 .. $#_; }); return ($v3,$v4); } *handle_missing = \&handle_missing_values; *average = *mean; *avg = *mean; *var = *variance; *cov = *covariance; *cor = *correlation; *corr = *correlation; *lsf = *leastsquarefit; *LSF = *leastsquarefit; 1; Statistics-Basic-1.6607/Changes0000644000175000017500000002050611707262466016211 0ustar jetterojettero1.6607: Mon Jan 23 2012 - forgot to update the copyright to 2012 1.6605: Sat Jan 21 2012 - change env var DEBUG to DEBUG_STATS_B (cpan698301@mstier.de) 1.6603: Mon Jan 24 2011 - fail to load Test::More gracefully, but don't require it even for build. 1.6602: Thu Sep 30 2010 - changes to make this work again in 5.6.x (hint provided by Jerome Provensal) 1.6601: Sat Sep 12 2009 - The debian build devs set TEST_AUTHOR, then created a bug report concerning the results. First things first, make it so setting TEST_AUTHOR doesn't work unless you set a specific code -- are you the author? No? Then don't complain about the suggestions from Perl-Critic - fixed the various things the latest Perl-Critic complains about -- nothing really, and a bug in the critic. 1.6600: Sun Jun 28 2009 - new test: create each object in its empty state, make sure its really empty. - added an importer interface for the %ENV vars - removing the ENV vars (except for pre-compile init) - finished updating the pods for all the 1.66 changes 1.6600: Sat Jun 27 2009 - worked on computed vectors a little. decided it should be possible to insert into them, instead inserting into the input_vector. - finished a lot more 1.66 docs - since two vectors remain separate objects under $v1->set_vector($v2), they shouldn't be linked together from that -- set_vector now copies instead of linking. computed() vectors can serve that role instead. - made sure all the object accessors return the object - made set_vector() take nonscalars like all the export constructors - made the export constructors use the new set_vector() via new() - made all the objects true in bool context 1.6600: Wed Jun 24 2009 - _OVBed: median, StdDev, Variance - fixed bugs resulting from the above - made quite a lot of the methods of Vectors private - trying to make the pods more consistent and informative - renamed size() as query_size() to be really consistent -- but put in an undocumented alias named size() ... maybe deprecate later. - renamed ginsert() append(), but left ginsert() operational, with no real chance of deprecation later 1.6600: Tue Jun 23 2009 - installed a lotta DRY on the two vector classes, will continue this tonight and on lunch break most likely. - worked on the docs, they need a good deal of work - _OVBed Mean - noticed a half-way implemented set_vector fill-disabler, why isn't it finished? - added a query_filled to check to see if a vector is full - made sure the _OVB and _TVB base classes know about the half implemented fill disabler - use query_filled in various places, to make it automagic like everything else - I gave up on the second argument to set_size... it needs to be kinda system wide to work right. Another $ENV{VAR}. *sigh* - _OVBed Mode 1.6600: Mon Jun 22 2009 - started added best practices stuff to the dist 1.6500: Fri May 29 2009 - I get asked, "does S::B handle missing values?" quite a lot. - YES IT DOES! (now) 1.6007: Sat May 2 2009 - fixed copyright information on request - fixed various docbugs - finished a thought about outliers 1.6005: Thu Mar 26 12:22:23 EDT 2009 - META.yml stuff 1.6004: Sun Mar 1 07:15:37 EST 2009 - doc bug found by Raj Chandran 1.6003: Sun Feb 8 17:21:39 EST 2009 - perl 5.8.0 can't deal with this program, requiring 5.8.1: my $o = bless {v1=>1, v2=>2}, "class"; print "K:$_; V:$o->{$_}\n" for keys %$o; print "K:$_; V:$o->{$_}\n" for qw(v1 v2 v3); 1.6002: Mon Jan 19 07:16:55 EST 2009 - I'm skipping the t/60_ tests without recent versions of Math::BigFloat. No idea what causes the problems, but since the module isn't required, it doesn't even tell me the version of the module. - Perl's locale support is embarrassingly buggy. Under certain conditions, Number::Format will die because perl's POSIX getlocale stuff returns some (but not all) of certain locales. This stuff is reproducible on almost any machine, so I didn't bother to report it. WRW installed a fix in NF 1.61(a) that sets the thousands_sep to "" when it's the same as the decimal_point. Fixed (sorta). 1.6001: Thu Nov 6 07:06:24 EST 2008 - noted the population vs sample issue (again) 1.6: Sun Oct 19 07:24:19 EDT 2008 - rather than fixing more of the tests using abs(blah-blarg) 10; my $lsf = new Statistics::Basic::LeastSquareFit([1 .. 10], [1 .. 10]); ok( $lsf->query->[0], 0); # alpha ok( $lsf->query->[1], 1); # beta $lsf->set_vector([1 .. 10], [map((3 + $_ * 4), 1 .. 10)]); ok( $lsf->query->[0], 3); # alpha ok( $lsf->query->[1], 4); # beta my $j = new Statistics::Basic::LeastSquareFit; $j->set_vector([1 .. 10], [1 .. 10]); ok( $j->query->[0], 0); # alpha ok( $j->query->[1], 1); # beta my $k = new Statistics::Basic::LeastSquareFit; my @v = ($k->query_vector1, $k->query_vector2); my @a = (1 .. 10); my @b = map(13 + $_*19, 1 .. 10); for my $i (0 .. $#a) { $k->ginsert($a[$i], $b[$i]); } ok( $k->query->[0], 13); # alpha ok( $k->query->[1], 19); # beta # test overloads my ($alpha, $beta) = $j->query; ok( "$j", qr/.*alpha.*$alpha.*beta.*$beta/ ); ok( not eval { my $test = 0+$j; 1 } ); Statistics-Basic-1.6607/t/53_co_persistance.t0000644000175000017500000000100111221726435020633 0ustar jetterojettero use strict; use Test; use Statistics::Basic qw(:all ignore_env); use Scalar::Util qw(refaddr); plan tests => 8; my $v1 = vector([1 .. 5]); my $v2 = $v1->copy; ok( refaddr($v1) != refaddr($v2) ); ok( $v1, $v2 ); my $cov = covariance($v1, $v2); ok( refaddr($cov->query_vector1), refaddr($v1) ); ok( refaddr($cov->query_vector2), refaddr($v2) ); ok( $cov, 2 ); my $cor = correlation($v1, $v2); ok( refaddr($cor->query_vector1), refaddr($v1) ); ok( refaddr($cor->query_vector2), refaddr($v2) ); ok( $cor, 1 ); Statistics-Basic-1.6607/t/54_doc_example.t0000644000175000017500000000103011220467120020105 0ustar jetterojettero use Statistics::Basic qw(:all); my $v1 = vector(1,2,3,4,5); my $v2 = vector($v1); my $sd = stddev( $v1 ); my $v3 = $sd->query_vector; my $m1 = mean( $v1 ); my $m2 = $sd->query_mean; my $m3 = Statistics::Basic::Mean->new( $v1 ); my $v4 = $m3->query_vector; use Scalar::Util qw(refaddr); use Test; plan tests => 5; ok( refaddr($v1), refaddr($v2) ); ok( refaddr($v2), refaddr($v3) ); ok( refaddr($m1), refaddr($m2) ); ok( refaddr($m2), refaddr($m3) ); ok( refaddr($v3), refaddr($v4) ); Statistics-Basic-1.6607/t/09_test_importer_vars_debug.t0000644000175000017500000000026711221706536022751 0ustar jetterojettero use Test; use Statistics::Basic qw(:all debug); plan tests => 1; $SIG{__WARN__} = sub { ok(1) if $_[0] =~ m/recalc_needed Statistics::Basic::Mean/; }; my $mean = mean(1,2,3); Statistics-Basic-1.6607/t/75_missing_correlated.t0000644000175000017500000000041111222114117021504 0ustar jetterojettero use Test; use Statistics::Basic qw(:all); plan tests => 1; $SIG{__WARN__} = sub { die " FATAL WARNING: $_[0] " }; my $v1 = vector(1 .. 5, undef, undef, 7); my $v2 = vector(1 .. 4, undef, undef, 8, 7); my @f = handle_missing($v1,$v2); ok( correlation(@f), 1 ); Statistics-Basic-1.6607/t/09_test_importer_vars_ipres.t0000644000175000017500000000015511221726435023001 0ustar jetterojettero use Test; use Statistics::Basic qw(:all ipres); plan tests => 1; my $mean = mean(1,3,7); ok($mean, 3.67); Statistics-Basic-1.6607/t/08_cvec.t0000644000175000017500000000162011221726435016561 0ustar jetterojettero use strict; use Test; use Statistics::Basic qw(:all ignore_env); plan tests => 12; my $i = Statistics::Basic::Vector->new([ 1 .. 30 ]); my $j = Statistics::Basic::ComputedVector->new( $i ); $j->set_filter(sub { grep {$_<= 3} @_ }); ok( $j->query_size, 3 ); ok( $j, "[1, 2, 3]" ); $i->insert( 2 ); ok( $j->query_size, 3 ); ok( $j, "[2, 3, 2]" ); my $S = computed(1,2,3); $S->set_filter(sub {map {$_+1} @_ }); my $Sr = $S->query; { my $Sr2 = $S->query; my @Sr2 = $S->query; ok( "@Sr2", "@$Sr2" ); ok( "@Sr2", "@$Sr" ); } $S->insert(7); $S->ginsert(9); { my $Sr2 = $S->query; my @Sr2 = $S->query; ok( "@Sr2", "@$Sr2" ); ok( "@Sr2", "@$Sr" ); } $S->set_vector($i); { my $Sr2 = $S->query; my @Sr2 = $S->query; ok( "@Sr2", "@$Sr2" ); ok( "@Sr2", "@$Sr" ); } $S->set_vector([1,2,3,5]); { my $Sr2 = $S->query; my @Sr2 = $S->query; ok( "@Sr2", "@$Sr2" ); ok( "@Sr2", "@$Sr" ); } Statistics-Basic-1.6607/t/09_test_importer_vars_nofill1.t0000644000175000017500000000021011221706536023213 0ustar jetterojettero use Test; use Statistics::Basic qw(:all nofill=1); plan tests => 1; my $vector = vector()->set_size(10); ok($vector->query_size, 0); Statistics-Basic-1.6607/t/09_test_importer_vars_ipres2.t0000644000175000017500000000015711221706536023065 0ustar jetterojettero use Test; use Statistics::Basic qw(:all ipres=2); plan tests => 1; my $mean = mean(1,3,7); ok($mean, 3.67); Statistics-Basic-1.6607/t/09_test_importer_vars_debug0.t0000644000175000017500000000033111221706536023021 0ustar jetterojettero use Test; use Statistics::Basic qw(:all debug=0); plan tests => 1; my $warn = 0; $SIG{__WARN__} = sub { $warn++ if $_[0] =~ m/recalc_needed Statistics::Basic::Mean/; }; my $mean = mean(1,2,3); ok( $warn, 0 ) Statistics-Basic-1.6607/t/10_median.t0000644000175000017500000000105111220401071017046 0ustar jetterojettero use strict; use Test; use Statistics::Basic qw(:all); plan tests => 8; my $sbm = new Statistics::Basic::Median([1 .. 3]); ok($sbm->query, 2); $sbm->insert( 10 ); ok($sbm->query, 3); $sbm->set_size( 5 ); ok($sbm->query, 2); $sbm->ginsert( 9 ); ok($sbm->query, 2.5); $sbm->set_vector( [2, 3 .. 5, 7, 0, 0] ); ok($sbm->query, 3); my $j = new Statistics::Basic::Median; $j->set_vector( [1 .. 3] ); ok($j->query, 2); ok( median(6, 47, 49, 15, 42, 41, 7, 39, 43, 40, 36), 40 ); ok( median(7, 15, 36, 39, 40, 41), 37.5 ); Statistics-Basic-1.6607/t/17_stddev.t0000644000175000017500000000104311220466006017123 0ustar jetterojettero use strict; use Test; use Statistics::Basic; plan tests => 5; PART1: { my $stddev = new Statistics::Basic::StdDev([0, 2, 3, 4]); ok( $stddev->query == sqrt( 35/16 ) ); $stddev->insert(7); ok( $stddev->query == sqrt( 14/4 ) ); $stddev->set_vector([2, 3]); ok( $stddev->query == sqrt( 1/4 ) ); $stddev->ginsert( 7 ); ok( $stddev->query == sqrt( 14/3 ) ); } PART2: { my $stddev = new Statistics::Basic::StdDev; $stddev->set_vector([2, 3]); ok( $stddev->query == sqrt( 1/4 ) ); } Statistics-Basic-1.6607/t/pod_coverage.t0000644000175000017500000000141511517317524017774 0ustar jetterojettero#!/usr/bin/perl -w use strict; unless( eval { require Test::More; 1} ) { print "1..0 # SKIP Author test.\n"; exit 0; } Test::More->import(); no warnings; # NOTE: please do not blame me for suggetions from this test. Do not set # TEST_AUTHOR and then tell me about it. Use test at your own risk. if ($ENV{TEST_AUTHOR} ne "author972" ) { plan( skip_all => 'Author test.' ); } eval "use Test::Pod::Coverage 1.00"; plan( skip_all => "Test::Pod::Coverage 1.00 required for testing POD" ) if $@; all_pod_coverage_ok(); #my @modules = grep { !m/ComputedVector/ } all_modules(); #pod_coverage_ok( $_ ) for @modules; #my $trustme = { trustme => [qr/^(set_size|insert|append|ginsert|set_vector)$/] }; #pod_coverage_ok( "Statistics::Basic::ComputedVector", $trustme ); Statistics-Basic-1.6607/t/60_bigfloats.t0000644000175000017500000000212611706577612017624 0ustar jetterojetterouse strict; use Test; use Statistics::Basic qw(:all toler=0.000_001); plan tests => (my $t = 4); unless( eval 'use Math::BigFloat; 1' ) { warn " [skipping all Math::BigFloat tests, as it does't appear to load]\n"; skip(1,1,1) for 1 .. $t; exit 0; } my $v = $Math::BigFloat::VERSION; warn " [M::BF version: $v]\n"; if( $v < 1.60 ) { warn " [skipping all Math::BigFloat tests, mysterious problems crop up without recent versions of M::BF]\n"; skip(1,1,1) for 1 .. $t; exit 0; } my $corr = new Statistics::Basic::Correlation([1 .. 10], [1 .. 10]); ok( $corr == 1 ); $corr->insert( 11, 7 ); ok( $corr == ( (129/20) / (sqrt(609/100) * sqrt(165/20)))); $corr = new Statistics::Basic::Correlation([map {Math::BigFloat->new($_)} 1 .. 10], [map {Math::BigFloat->new($_)} 1 .. 10]); ok( $corr == 1 ); $corr->insert( map {Math::BigFloat->new($_)} 11, 7 ); my $tv = ((Math::BigFloat->new(129)/20) / (sqrt(Math::BigFloat->new(609)/100) * sqrt(Math::BigFloat->new(165)/20))); #my $d = $corr - $tv; #warn " d: $d"; # 0.0000362452 $Statistics::Basic::TOLER = 0.000_1; ok( $corr == $tv ); Statistics-Basic-1.6607/t/05_load_them.t0000644000175000017500000000031111220516201017551 0ustar jetterojettero use strict; use Test; my @packages = map { s/\.pm$//; s/^.+?\///; "Statistics::Basic::$_" } ; plan tests => int @packages; for my $p (@packages) { eval "use $p"; ok($@, ""); } Statistics-Basic-1.6607/t/09_test_importer_vars_ipres1.t0000644000175000017500000000015611221706536023063 0ustar jetterojettero use Test; use Statistics::Basic qw(:all ipres=1); plan tests => 1; my $mean = mean(1,3,7); ok($mean, 3.7); Statistics-Basic-1.6607/t/critic.t0000644000175000017500000000105511517317501016607 0ustar jetterojettero#!/usr/bin/perl -w use strict; unless( eval { require Test::More; 1} ) { print "1..0 # SKIP Author test.\n"; exit 0; } Test::More->import(); no warnings; # NOTE: please do not blame me for suggetions from this test. Do not set # TEST_AUTHOR and then tell me about it. Use test at your own risk. if ($ENV{TEST_AUTHOR} ne "author972") { plan( skip_all => 'Author test.' ); } unless( eval { require Test::Perl::Critic; 1 } ) { plan( skip_all => 'Test::Perl::Critic required for test.'); } Test::Perl::Critic->import(); all_critic_ok(); Statistics-Basic-1.6607/t/75_filtered_missings.t0000644000175000017500000000133411221511417021351 0ustar jetterojettero use Test; use Statistics::Basic qw(:all); plan tests => 8; $SIG{__WARN__} = sub { die " FATAL WARNING: $_[0] " }; my $v1 = vector(1,2,3,undef,4); ok("$v1", "[1, 2, 3, _, 4]"); my $v2 = vector(1,2,3,4, undef); ok("$v2", "[1, 2, 3, 4, _]"); my $v3 = computed($v1); my $v4 = computed($v2); ok("$v3", "[1, 2, 3, _, 4]"); ok("$v4", "[1, 2, 3, 4, _]"); $v3->set_filter(sub { my @v = $v2->query; map {$_[$_]} grep { defined $v[$_] and defined $_[$_] } 0 .. $#_; }); $v4->set_filter(sub { my @v = $v1->query; map {$_[$_]} grep { defined $v[$_] and defined $_[$_] } 0 .. $#_; }); ok("$v3", "[1, 2, 3]"); ok("$v4", "[1, 2, 3]"); my ($v5, $v6) = handle_missing_values($v1, $v2); ok("$v5", "$v3"); ok("$v6", "$v4"); Statistics-Basic-1.6607/t/10_mode.t0000644000175000017500000000075511221726435016566 0ustar jetterojettero use strict; use Test; use Statistics::Basic qw(:all ignore_env); plan tests => 6; my $sbm = new Statistics::Basic::Mode([1 .. 3]); ok($sbm->query, "[1, 2, 3]"); $sbm->insert( 3 ); ok($sbm->query, 3); $sbm->set_size( 5 ); # adds two 0s on the end ok($sbm->query, "[0, 3]"); $sbm->ginsert( 2 ); ok($sbm->query, "[0, 2, 3]"); $sbm->set_vector( [2, 3 .. 5, 7, 0, 0] ); ok($sbm->query, 0); my $j = new Statistics::Basic::Mode; $j->set_vector( [1, 2, 3, 3, 3, 2] ); ok($j->query, 3); Statistics-Basic-1.6607/t/19_combo.t0000644000175000017500000000236311221444717016747 0ustar jetterojettero use strict; use Test; use Statistics::Basic qw(:all); plan tests => 16; my $v = vector(1,2,3); my $m = mean($v); my $s = stddev($v); ok($m, mean(1,2,3)); ok($s, stddev(1,2,3)); $v->insert(4); ok($m, mean(2,3,4)); ok($s, stddev(2,3,4)); $m->insert(5); ok($m, mean(3,4,5)); ok($s, stddev(3,4,5)); $s->insert(6); ok($m, mean(4,5,6)); ok($s, stddev(4,5,6)); $v = vector(1,2,3); $m = mean($v); $s = stddev($v); ok($m, mean(1,2,3)); ok($s, stddev(1,2,3)); $v->ginsert(4); ok($m, mean(1,2,3,4)); ok($s, stddev(1,2,3,4)); $m->ginsert(5); ok($m, mean(1,2,3,4,5)); ok($s, stddev(1,2,3,4,5)); $s->ginsert(6); ok($m, mean(1,2,3,4,5,6)); ok($s, stddev(1,2,3,4,5,6)); Statistics-Basic-1.6607/t/09_test_importer_vars_nofill0.t0000644000175000017500000000021111221706536023213 0ustar jetterojettero use Test; use Statistics::Basic qw(:all nofill=0); plan tests => 1; my $vector = vector()->set_size(10); ok($vector->query_size, 10); Statistics-Basic-1.6607/t/08_filter_outliers.t0000644000175000017500000000162011221726435021054 0ustar jetterojettero use strict; use Test; use Statistics::Basic qw(:all ignore_env); plan tests => 11; my @a = (((1,2,3) x 7), 15); my @b = (((1,2,3) x 7)); my $v1 = vector(@a); my $v2 = vector(@b); my $c = computed($v1); $c->set_filter(sub { my $s = stddev($v1); my $m = mean($v1); grep { abs( $_-$m ) <= $s } @_ }); ok( $c, $v2 ); ok( mean($c), mean($v2) ); ok( mean($c), 2 ); ok( median($c), 2 ); ok( mode($c), "[1, 2, 3]" ); $v1->set_vector([6, 47, 49, 15, 42, 41, 7, 39, 43, 40, 36]); my $Q2 = median($v1); my $lh = computed($v1); $lh->set_filter(sub { grep {$_<$Q2} @_ }); my $uh = computed($v1); $uh->set_filter(sub { grep {$_>$Q2} @_ }); my $Q1 = median( $lh ); my $Q3 = median( $uh ); ok( $Q1, 15 ); ok( $Q2, 40 ); ok( $Q3, 43 ); $v1->set_vector([7, 15, 36, 39, 40, 41]); $Q2 = median( $v1 ); $Q1 = median( $lh ); $Q3 = median( $uh ); ok( $Q1, 15 ); ok( $Q2, 37.5 ); ok( $Q3, 43 ); Statistics-Basic-1.6607/t/53_persistance.t0000644000175000017500000000164611162234137020166 0ustar jetterojettero use strict; use Test; use Statistics::Basic qw(:all); use Scalar::Util qw(refaddr); plan tests => 18; my $v = vector([1 .. 7]); my $m = mean($v); my $V = var($v); my $s = stddev($v); ok( $m, 4 ); # NOTE: oddly, the mean and variance of 1..7 ok( $V, 4 ); # are both 4 ok( $s, 2 ); # and sqrt(4) is 2 ok( refaddr($v->{c}{mean}), refaddr($m) ); ok( refaddr($v->{c}{variance}), refaddr($V) ); ok( refaddr($v->{c}{stddev}), refaddr($s) ); ok( refaddr($m->{v}), refaddr($v) ); ok( refaddr($V->{v}), refaddr($v) ); ok( refaddr($s->{V}{v}), refaddr($v) ); ok( refaddr($V->{m}), refaddr($m) ); ok( refaddr($s->{V}), refaddr($V) ); ok( refaddr($s->{V}{m}), refaddr($m) ); undef $s; ok( $s, undef ); ok( $v->{c}{stddev}, undef ); undef $V; ok( $V, undef ); ok( $v->{c}{variance}, undef ); undef $m; ok( $m, undef ); ok( $v->{c}{mean}, undef ); sub sum { my $sum = shift; $sum += $_ for @_; $sum; } Statistics-Basic-1.6607/t/10_mean.t0000644000175000017500000000063211220401071016535 0ustar jetterojettero use strict; use Test; use Statistics::Basic; plan tests => 6; my $sbm = new Statistics::Basic::Mean([1 .. 3]); ok($sbm->query, 2); $sbm->insert( 10 ); ok($sbm->query, 5); $sbm->set_size( 5 ); ok($sbm->query, 3); $sbm->ginsert( 9 ); ok($sbm->query, 4); $sbm->set_vector( [2, 3 .. 5, 7, 0, 0] ); ok($sbm->query, 3); my $j = new Statistics::Basic::Mean; $j->set_vector( [1 .. 3] ); ok($j->query, 2); Statistics-Basic-1.6607/t/15_variance.t0000644000175000017500000000072711162234137017433 0ustar jetterojettero use strict; use Test; use Statistics::Basic; plan tests => 6; my $sbv = new Statistics::Basic::Variance([1 .. 3]); ok( $sbv->query == (2/3) ); $sbv->insert( 4 ); ok( $sbv->query == (2/3) ); $sbv->set_size( 4 ); ok( $sbv->query == (35/16) ); $sbv->set_vector( [5 .. 7] ); ok( $sbv->query == (2/3) ); $sbv->ginsert( 8 ); ok( $sbv->query == (5/4) ); my $j = new Statistics::Basic::Variance; $j->set_vector([1 .. 3]); ok( $j->query == (2/3) ); Statistics-Basic-1.6607/t/30_empty_constructor_tests.t0000644000175000017500000000200711221656613022661 0ustar jetterojettero use Test; use Statistics::Basic qw(:all); my $warning = 0; $SIG{__WARN__} = sub { warn "\n\e[1;33mWARNING DETECTED: @_\e[m\n"; $warning ++ }; my @zerosies = ( scalar vector(), scalar computed(), ); my @onesies = ( scalar mean(), scalar median(), scalar mode(), scalar stddev(), scalar variance(), ); my @twosies = ( scalar correlation(), scalar covariance(), scalar lsf(), ); plan tests => 1 # warnings + 1*@zerosies # vector tests + 1*@onesies # one-vector tests + 2*@twosies # two-vector tests ; for (@zerosies) { my $r = ref $_; my $s = "$r " . $_->query_size; ok($s, "$r 0"); } for (@onesies) { my $v = $_->query_vector; my $r = ref $_; my $s = "$r " . $v->query_size; ok($s, "$r 0"); } for (@twosies) { my $v1 = $_->query_vector1; my $v2 = $_->query_vector2; my $r = ref $_; my $s1 = "$r " . $v1->query_size; my $s2 = "$r " . $v2->query_size; ok($s1, "$r 0"); ok($s1, "$r 0"); } ok($warning, 0); Statistics-Basic-1.6607/t/09_test_importer_vars_debug1.t0000644000175000017500000000027111221706536023025 0ustar jetterojettero use Test; use Statistics::Basic qw(:all debug=1); plan tests => 1; $SIG{__WARN__} = sub { ok(1) if $_[0] =~ m/recalc_needed Statistics::Basic::Mean/; }; my $mean = mean(1,2,3); Statistics-Basic-1.6607/t/pod.t0000644000175000017500000000101211517317515016112 0ustar jetterojettero#!/usr/bin/perl -w use strict; unless( eval { require Test::More; 1} ) { print "1..0 # SKIP Author test.\n"; exit 0; } Test::More->import(); no warnings; # NOTE: please do not blame me for suggetions from this test. Do not set # TEST_AUTHOR and then tell me about it. Use test at your own risk. if ($ENV{TEST_AUTHOR} ne "author972") { plan( skip_all => 'Author test.' ); } eval "use Test::Pod 1.00"; ## no critic plan( skip_all => "Test::Pod 1.00 required for testing POD" ) if $@; all_pod_files_ok(); Statistics-Basic-1.6607/t/15_covariance.t0000644000175000017500000000153211222115573017747 0ustar jetterojettero use strict; use Test; use Statistics::Basic; plan tests => 8; my $cov = new Statistics::Basic::Covariance([1 .. 3], [1 .. 3]); my $var = new Statistics::Basic::Variance( $cov->query_vector1 ); ok( $cov->query, (2/3) ); $cov->set_size( 4 ); ok( $cov->query, (5/4) ); $cov->insert( 9, 9 ); ok( $cov->query, (155/16) ); # 38.75/4; 3.75 = mean (1,2,3,9); 38.75 = sum( map {(3.75-$_)**2} 1,2,3,9 ) ok( $var->query, $cov->query ); $cov->insert( [10 .. 11], [11 .. 12] ); ok( $cov->query, (173/16) ); # 173 = 4*sum( ($m1-3)*($m2-3), ($m1-9)*($m2-9), ($m1-10)*($m2-11), ($m1-11)*($m2-12) ) $cov->set_vector( [10 .. 11], [11 .. 12] ); ok( $cov->query, (1/4) ); $cov->ginsert( [13, 0], [13, 0] ); ok( $cov->query, (105/4) ); my $j = new Statistics::Basic::Covariance; $j->set_vector([1 .. 3], [1 .. 3]); ok( $j->query, (2/3) ); Statistics-Basic-1.6607/t/09_test_importer_vars_toler.t0000644000175000017500000000021211706577612023007 0ustar jetterojettero BEGIN { $ENV{TOLER} = 1 } use Test; use Statistics::Basic qw(:all toler); plan tests => 1; my $mean = mean(1,3,7); ok($mean != 3.7); Statistics-Basic-1.6607/t/07_vector.t0000644000175000017500000000345111706577612017157 0ustar jetterojettero use strict; use Test; use Statistics::Basic qw(:all ignore_env); plan tests => 35; my $v = new Statistics::Basic::Vector([1 .. 3]); ok( $v->query_size, 3 ); $v->set_size( 4 ); # fix_size() fills in with 0s ok( $v->query_size, 4 ); ok( $v->query_filled ); { local $Statistics::Basic::NOFILL = 1; $v->set_size( 6 ); # waits for you to insert() ok( $v->query_size, 4 ); ok( !$v->query_filled ); $v->insert( 9 ); # waits for you to insert() ok( $v->query_size, 5 ); ok( !$v->query_filled ); } $v->insert(5); # auto fills ok( $v->query_size, 6 ); $v->insert( [10..13], 14..15 ); ok( $v->query_size, 6 ); my $j = new Statistics::Basic::Vector; ok( $j->query_size, 0 ); $j->set_vector([7,9,21]); ok( $j->query_size, 3 ); ok( $j, "[7, 9, 21]"); $j->set_size(0); ok( $j, "[]" ); ok( $j->query_size, 0 ); my $k = $j->copy; $k->ginsert(7); $j->ginsert(9); ok( $j->query_size, 1 ); ok( $k->query_size, 1 ); $j->ginsert(7); ok( $j->query_size, 2 ); ok( $k->query_size, 1 ); ok( $j, "[9, 7]" ); ok( $k, "[7]" ); $k->set_vector($j); $j->ginsert(33); ok( $j, "[9, 7, 33]" ); ok( $k, "[9, 7]" ); my $w = $j->copy; ok( $w->query_size, $j->query_size ); ok( $w, $j ); $w->ginsert(6); ok( $w->query_size-1, $j->query_size ); my $str = "$w"; ok($str =~ s/, 6//, 1); ok( $str, $j ); my $S = vector([1,2,3]); my $Sr = $S->query; { my $Sr2 = $S->query; my @Sr2 = $S->query; ok( "@Sr2", "@$Sr2" ); ok( "@Sr2", "@$Sr" ); } $S->insert(7); $S->ginsert(9); { my $Sr2 = $S->query; my @Sr2 = $S->query; ok( "@Sr2", "@$Sr2" ); ok( "@Sr2", "@$Sr" ); } $S->set_vector($w); { my $Sr2 = $S->query; my @Sr2 = $S->query; ok( "@Sr2", "@$Sr2" ); ok( "@Sr2", "@$Sr" ); } $S->set_vector([1,2,3,5]); { my $Sr2 = $S->query; my @Sr2 = $S->query; ok( "@Sr2", "@$Sr2" ); ok( "@Sr2", "@$Sr" ); } Statistics-Basic-1.6607/t/20_correlation.t0000644000175000017500000000141411221726435020155 0ustar jetterojetterouse strict; use Test; use Statistics::Basic qw(:all toler=0.000_001); plan tests => 7; my $corr = new Statistics::Basic::Correlation([1 .. 10], [1 .. 10]); ok( $corr == 1 ) or warn "\ncorr: $corr"; $corr->insert( 11, 7 ); ok( $corr == ( (129/20) / (sqrt(609/100) * sqrt(165/20)))) or warn "\ncorr: $corr"; $corr->set_vector( [11 .. 13], [11 .. 13] ); ok( $corr == 1 ); $corr->ginsert( 13, 12 ); ok( $corr == ( (1/2) / (sqrt(11/16) * sqrt(1/2)) )) or warn "\ncorr: $corr"; my $j = new Statistics::Basic::Correlation; $j->set_vector( [11 .. 13], [11 .. 13] ); ok( $j == 1 ) or warn "\ncorr: $j"; my $c = correlation([4,7,7], [4,7,7]); ok( $c == 1 ) or warn "\ncorr: $c"; $c->insert(3,4); ok( $c, correlation([7,7,3], [7,7,4]) ); Statistics-Basic-1.6607/t/25_correlate_computed.t0000644000175000017500000000124411221726435021522 0ustar jetterojetterouse strict; use Test; use Statistics::Basic qw(:all toler=0.05); plan tests => 2; my $warning = 0; $SIG{__WARN__} = sub { warn "\n\e[1;33mWARNING DETECTED: @_\e[m\n"; $warning ++ }; # perl -e 'print " ", rand($_), "\n" for 1 .. 10' my @rand = (qw( 0.728712105731578 0.352966697601858 2.89744693355025 0.100965906294533 2.6368492231135 5.30772892749511 4.98230531045954 2.73849156345449 2.27253176264066 0.349800238043372 )); my $v1 = vector(1 .. 10); my $v2 = computed($v1)->set_filter(sub { map {$_ + 0.5 * (shift @rand)} @_ }); my $corr = cor( $v1, $v2 ); ok( $corr == 1 ) or warn "\n\$corr=$corr\n"; ok( $warning, 0 ); Statistics-Basic-1.6607/t/09_test_importer_vars_toler1.t0000644000175000017500000000016011221726435023061 0ustar jetterojettero use Test; use Statistics::Basic qw(:all toler=0); plan tests => 1; my $mean = mean(1,3,7); ok($mean != 3.7); Statistics-Basic-1.6607/t/10_moving_average.t0000644000175000017500000000042611221726435020626 0ustar jetterojettero use strict; use Test; use Statistics::Basic qw(:all nofill); plan tests => 2*(1+(my $t = 3)); my $avg = avg()->set_size($t); ok( $avg->query_size, 0 ); for(1 .. $t) { ok( $avg->query, undef ); $avg->insert(1); ok( $avg->query_size, $_ ); } ok( $avg->query, 1 ); Statistics-Basic-1.6607/t/09_test_importer_vars_nofill.t0000644000175000017500000000020611221706536023137 0ustar jetterojettero use Test; use Statistics::Basic qw(:all nofill); plan tests => 1; my $vector = vector()->set_size(10); ok($vector->query_size, 0); Statistics-Basic-1.6607/.perlcriticrc0000644000175000017500000000022211252701045017357 0ustar jetterojetteroseverity = 4 verbose = 8 exclude = ValuesAndExpressions::ProhibitConstantPragma Subroutines::RequireArgUnpacking Objects::ProhibitIndirectSyntax Statistics-Basic-1.6607/Basic/0000750000175000017500000000000011707262605015722 5ustar jetterojetteroStatistics-Basic-1.6607/Basic/LeastSquareFit.pm0000644000175000017500000000621411706577612021172 0ustar jetterojettero package Statistics::Basic::LeastSquareFit; use strict; use warnings; use Carp; use base 'Statistics::Basic::_TwoVectorBase'; use overload '""' => sub { my ($alpha,$beta) = map{$Statistics::Basic::fmt->format_number($_, $Statistics::Basic::IPRES)} $_[0]->query; "LSF( alpha: $alpha, beta: $beta )"; }, '0+' => sub { croak "the result of LSF may not be used as a number" }, fallback => 1; # tries to do what it would have done if this wasn't present. # new {{{ sub new { my $this = shift; my @var1 = (shift || ()); my @var2 = (shift || ()); my $v1 = eval { Statistics::Basic::Vector->new( @var1 ) } or croak $@; my $v2 = eval { Statistics::Basic::Vector->new( @var2 ) } or croak $@; $this = bless {}, $this; my $c = $v1->_get_linked_computer( LSF => $v2 ); return $c if $c; $this->{_vectors} = [ $v1, $v2 ]; $this->{vrx} = eval { Statistics::Basic::Variance->new($v1) } or croak $@; $this->{mnx} = eval { Statistics::Basic::Mean->new($v1) } or croak $@; $this->{mny} = eval { Statistics::Basic::Mean->new($v2) } or croak $@; $this->{cov} = eval { Statistics::Basic::Covariance->new($v1, $v2) } or croak $@; $v1->_set_linked_computer( LSF => $this, $v2 ); $v2->_set_linked_computer( LSF => $this, $v1 ); return $this; } # }}} # _recalc {{{ sub _recalc { my $this = shift; delete $this->{recalc_needed}; delete $this->{alpha}; delete $this->{beta}; my $vrx = $this->{vrx}->query; return unless defined $vrx; return unless $vrx > 0; my $mnx = $this->{mnx}->query; return unless defined $mnx; return unless $mnx > 0; my $mny = $this->{mny}->query; return unless defined $mny; my $cov = $this->{cov}->query; return unless defined $cov; $this->{beta} = ($cov / $vrx); $this->{alpha} = ($mny - ($this->{beta} * $mnx)); warn "[recalc " . ref($this) . "] (alpha: $this->{alpha}, beta: $this->{beta})\n" if $Statistics::Basic::DEBUG; return; } # }}} # query {{{ sub query { my $this = shift; $this->_recalc if $this->{recalc_needed}; warn "[query " . ref($this) . " ($this->{alpha}, $this->{beta})]\n" if $Statistics::Basic::DEBUG; return (wantarray ? ($this->{alpha}, $this->{beta}) : [$this->{alpha}, $this->{beta}] ); } # }}} # query_vector1 {{{ sub query_vector1 { my $this = shift; return $this->{cov}->query_vector1; } # }}} # query_vector2 {{{ sub query_vector2 { my $this = shift; return $this->{cov}->query_vector2; } # }}} # query_mean1 {{{ sub query_mean1 { my $this = shift; return $this->{mnx}; } # }}} # query_variance1 {{{ sub query_variance1 { my $this = shift; return $this->{vrx}; } # }}} # query_covariance {{{ sub query_covariance { my $this = shift; return $this->{cov}; } # }}} # y_given_x {{{ sub y_given_x { my $this = shift; my ($alpha, $beta) = $this->query; my $x = shift; return ($beta*$x + $alpha); } # }}} # x_given_y {{{ sub x_given_y { my $this = shift; my ($alpha, $beta) = $this->query; my $y = shift; defined( my $x = eval { ( ($y-$alpha)/$beta ) }) or croak $@; return $x; } # }}} 1; Statistics-Basic-1.6607/Basic/ComputedVector.pm0000644000175000017500000000574611706577612021252 0ustar jetterojettero package Statistics::Basic::ComputedVector; use strict; use warnings; use Carp; our $tag_number = 0; use Statistics::Basic; use base 'Statistics::Basic::Vector'; # new {{{ sub new { my $class = shift; my $that = eval { Statistics::Basic::Vector->new(@_) } or croak $@; croak "input vector must be supplied to ComputedVector" unless defined $that; my $this = bless { tag=>(--$tag_number), c=>{}, input_vector=>$that, output_vector=>Statistics::Basic::Vector->new() }, $class; $this->_recalc_needed; return $this; } # }}} # copy {{{ sub copy { my $this = shift; my $that = __PACKAGE__->new( $this->{input_vector} ); $that->{computer} = $this->{computer}; warn "copied computedvector($this -> $that)\n" if $Statistics::Basic::DEBUG >= 3; return $that; } # }}} # set_filter {{{ sub set_filter { my $this = shift; my $cref = shift; croak "cref should be a code reference" unless ref($cref) eq "CODE"; $this->{computer} = $cref; my $a = Scalar::Util::refaddr($this); $this->{input_vector}->_set_computer( "cvec_$a" => $this ); # sets recalc needed in this object return $this; } # }}} # _recalc {{{ sub _recalc { my $this = shift; delete $this->{recalc_needed}; if( ref( my $c = $this->{computer} ) eq "CODE" ) { $this->{output_vector}->set_vector( [$c->($this->{input_vector}->query)] ); } else { $this->{output_vector}->set_vector( [$this->{input_vector}->query] ); } warn "[recalc " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; $this->_inform_computers_of_change; return; } # }}} # _recalc_needed {{{ sub _recalc_needed { my $this = shift; $this->{recalc_needed} = 1; warn "[recalc_needed " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; return; } # }}} # query_size {{{ sub query_size { my $this = shift; $this->_recalc if $this->{recalc_needed}; return $this->{output_vector}->query_size; } # maybe deprecate this later *size = \&query_size unless $ENV{TEST_AUTHOR}; # }}} # query {{{ sub query { my $this = shift; $this->_recalc if $this->{recalc_needed}; return $this->{output_vector}->query; } # }}} sub query_vector { return $_[0]{input_vector} } # query_filled {{{ sub query_filled { my $this = shift; # even though this makes little sense, imo, we need to provide it since so many other objects call it $this->_recalc if $this->{recalc_needed}; return $this->{input_vector}->query_filled; } # }}} sub _fix_size { croak "fix_size() makes no sense on computed vectors" } sub set_size { my $this = shift; $this->{input_vector}->set_size (@_); return $this } sub insert { my $this = shift; $this->{input_vector}->insert (@_); return $this } sub ginsert { my $this = shift; $this->{input_vector}->ginsert (@_); return $this } sub append { my $this = shift; $this->{input_vector}->append (@_); return $this } sub set_vector { my $this = shift; $this->{input_vector}->set_vector(@_); return $this } 1; Statistics-Basic-1.6607/Basic/Vector.pm0000644000175000017500000001465611706577612017551 0ustar jetterojetteropackage Statistics::Basic::Vector; use strict; use warnings; use Carp; use Scalar::Util qw(blessed weaken looks_like_number); our $tag_number = 0; use Statistics::Basic; use overload '0+' => sub { croak "attempt to use vector as scalar numerical value" }, '""' => sub { my $this = $_[0]; local $" = ", "; my @r = map { defined $_ ? $Statistics::Basic::fmt->format_number($_, $Statistics::Basic::IPRES) : "_" } $this->query; $Statistics::Basic::DEBUG ? "vector-$this->{tag}:[@r]" : "[@r]"; }, 'bool' => sub { 1 }, fallback => 1; # tries to do what it would have done if this wasn't present. # new {{{ sub new { my $class = shift; my $vector = $_[0]; if( blessed($vector) and $vector->isa(__PACKAGE__) ) { warn "vector->new called with blessed argument, returning $vector instead of making another\n" if $Statistics::Basic::DEBUG >= 3; return $vector; } my $this = bless {tag=>(++$tag_number), s=>0, c=>{}, v=>[]}, $class; $this->set_vector( @_ ); warn "created new vector $this\n" if $Statistics::Basic::DEBUG >= 3; return $this; } # }}} # copy {{{ sub copy { my $this = shift; my $that = __PACKAGE__->new( [@{$this->{v}}] ); warn "copied vector($this -> $that)\n" if $Statistics::Basic::DEBUG >= 3; return $that; } # }}} # _set_computer {{{ sub _set_computer { my $this = shift; while( my ($k,$v) = splice @_, 0, 2 ) { warn "$this set_computer($k => " . overload::StrVal($v) . ")\n" if $Statistics::Basic::DEBUG; weaken($this->{c}{$k} = $v); $v->_recalc_needed; } return; } # }}} # _set_linked_computer {{{ sub _set_linked_computer { my $this = shift; my $key = shift; my $var = shift; my $new_key = join("_", ($key, sort {$a<=>$b} map {$_->{tag}} @_)); $this->_set_computer( $new_key => $var ); return; } # }}} # _get_computer {{{ sub _get_computer { my $this = shift; my $k = shift; warn "$this get_computer($k): " . overload::StrVal($this->{c}{$k}||"") . "\n" if $Statistics::Basic::DEBUG; return $this->{c}{$k}; } # }}} # _get_linked_computer {{{ sub _get_linked_computer { my $this = shift; my $key = shift; my $new_key = join("_", ($key, sort {$a<=>$b} map {$_->{tag}} @_)); return $this->_get_computer( $new_key ); } # }}} # _inform_computers_of_change {{{ sub _inform_computers_of_change { my $this = shift; for my $k (keys %{ $this->{c} }) { my $v = $this->{c}{$k}; if( defined($v) and blessed($v) ) { $v->_recalc_needed; } else { delete $this->{c}{$k}; } } return; } # }}} # _fix_size {{{ sub _fix_size { my $this = shift; my $fixed = 0; my $d = @{$this->{v}} - $this->{s}; if( $d > 0 ) { splice @{$this->{v}}, 0, $d; $fixed = 1; } unless( $Statistics::Basic::NOFILL ) { if( $d < 0 ) { unshift @{$this->{v}}, # unshift so the 0s leave first map {0} $d .. -1; # add $d of them $fixed = 1; } } warn "[fix_size $this] [@{ $this->{v} }]\n" if $Statistics::Basic::DEBUG >= 2; return $fixed; } # }}} # query {{{ sub query { my $this = shift; return (wantarray ? @{$this->{v}} : $this->{v}); } # }}} # query_filled {{{ sub query_filled { my $this = shift; warn "[query_filled $this $this->{s}]\n" if $Statistics::Basic::DEBUG >= 1; return if @{$this->{v}} < $this->{s}; return 1; } # }}} # insert {{{ sub insert { my $this = shift; croak "you must define a vector size before using insert()" unless defined $this->{s}; for my $e (@_) { if( ref($e) and not blessed($e) ) { if( ref($e) eq "ARRAY" ) { push @{ $this->{v} }, @$e; warn "[insert $this] @$e\n" if $Statistics::Basic::DEBUG >= 1; } else { croak "insert() elements do not make sense"; } } else { push @{ $this->{v} }, $e; warn "[insert $this] $e\n" if $Statistics::Basic::DEBUG >= 1; } } $this->_fix_size; $this->_inform_computers_of_change; return $this; } # }}} # ginsert {{{ sub ginsert { my $this = shift; for my $e (@_) { if( ref($e) and not blessed($e)) { if( ref($e) eq "ARRAY" ) { push @{ $this->{v} }, @$e; warn "[ginsert $this] @$e\n" if $Statistics::Basic::DEBUG >= 1; } else { croak "insert() elements do not make sense"; } } else { push @{ $this->{v} }, $e; warn "[ginsert $this] $e\n" if $Statistics::Basic::DEBUG >= 1; } } $this->{s} = @{$this->{v}} if @{$this->{v}} > $this->{s}; $this->_inform_computers_of_change; return $this; } *append = \&ginsert; # }}} # query_size {{{ sub query_size { my $this = shift; return scalar @{$this->{v}}; } # maybe deprecate this later *size = \&query_size unless $ENV{TEST_AUTHOR}; # }}} # set_size {{{ sub set_size { my $this = shift; my $size = shift; croak "invalid vector size ($size)" if $size < 0; if( $this->{s} != $size ) { $this->{s} = $size; $this->_fix_size; $this->_inform_computers_of_change; } return $this; } # }}} # set_vector {{{ sub set_vector { my $this = shift; my $vector = $_[0]; if( ref($vector) eq "ARRAY" ) { @{$this->{v}} = @$vector; $this->{s} = int @$vector; $this->_inform_computers_of_change; } elsif( UNIVERSAL::isa($vector, "Statistics::Basic::ComputedVector") ) { $this->set_vector($vector->{input_vector}); } elsif( UNIVERSAL::isa($vector, "Statistics::Basic::Vector") ) { $this->{s} = $vector->{s}; @{$this->{v}} = @{$vector->{v}}; # copy the vector # I don't think this is the behavior that we really want, since they # stay separate objects, they shouldn't be linked like this. # $this->{s} = $vector->{s}; # $this->{v} = $vector->{v}; # this links the vectors together # $this->{c} = $vector->{c}; # so we should link their computers too } elsif( @_ ) { @{$this->{v}} = @_; $this->{s} = int @_; } elsif( defined $vector ) { croak "argument to set_vector() too strange"; } warn "[set_vector $this] [@{ $this->{v} }]\n" if $Statistics::Basic::DEBUG >= 2 and ref($this->{v}); return $this; } # }}} 1; Statistics-Basic-1.6607/Basic/StdDev.pm0000644000175000017500000000174111706577612017467 0ustar jetterojettero package Statistics::Basic::StdDev; use strict; use warnings; use Carp; use base 'Statistics::Basic::_OneVectorBase'; sub new { my $class = shift; warn "[new $class]\n" if $Statistics::Basic::DEBUG >= 2; my $this = bless {}, $class; my $variance = $this->{V} = eval { Statistics::Basic::Variance->new(@_) } or croak $@; my $vector = $this->{v} = $variance->query_vector; my $c = $vector->_get_computer( 'stddev' ); return $c if defined $c; $vector->_set_computer( stddev => $this ); return $this; } sub _recalc { my $this = shift; my $first = shift; delete $this->{recalc_needed}; my $var = $this->{V}->query; return unless defined $var; # no need to query filled here, variance does it for us warn "[recalc " . ref($this) . "] sqrt( $var )\n" if $Statistics::Basic::DEBUG; $this->{_value} = sqrt( $var ); return; } sub query_mean { my $this = shift; return $this->{V}->query_mean; } 1; Statistics-Basic-1.6607/Basic/Mode.pm0000644000175000017500000000350611706577612017163 0ustar jetterojettero package Statistics::Basic::Mode; use strict; use warnings; use Carp; use Statistics::Basic; use Scalar::Util qw(blessed); use base 'Statistics::Basic::_OneVectorBase'; use overload '""' => sub { defined( my $q = $_[0]->query ) or return "n/a"; return $q if ref $q; # vectors interpolate themselves $Statistics::Basic::fmt->format_number($_[0]->query, $Statistics::Basic::IPRES); }, '0+' => sub { my $q = $_[0]->query; croak "result is multimodal and cannot be used as a number" if ref $q; $q; }, fallback => 1; # tries to do what it would have done if this wasn't present. sub new { my $class = shift; warn "[new $class]\n" if $Statistics::Basic::DEBUG >= 2; my $this = bless {}, $class; my $vector = eval { Statistics::Basic::Vector->new(@_) } or croak $@; my $c = $vector->_get_computer("mode"); return $c if defined $c; $this->{v} = $vector; $vector->_set_computer( mode => $this ); return $this; } sub _recalc { my $this = shift; my $v = $this->{v}; my $cardinality = $v->query_size; delete $this->{recalc_needed}; delete $this->{_value}; return unless $cardinality > 0; return unless $v->query_filled; # only applicable in certain circumstances my %mode; my $max = 0; for my $val ($v->query) { no warnings 'uninitialized'; ## no critic my $t = ++ $mode{$val}; $max = $t if $t > $max; } my @a = sort {$a<=>$b} grep { $mode{$_}==$max } keys %mode; $this->{_value} = ( (@a == 1) ? $a[0] : Statistics::Basic::Vector->new(\@a) ); warn "[recalc " . ref($this) . "] count of $this->{_value} = $max\n" if $Statistics::Basic::DEBUG; return; } sub is_multimodal { my $this = shift; my $that = $this->query; return (blessed($that) ? 1:0); } 1; Statistics-Basic-1.6607/Basic/Covariance.pm0000644000175000017500000000507111706577612020350 0ustar jetterojettero package Statistics::Basic::Covariance; use strict; use warnings; use Carp; use base 'Statistics::Basic::_TwoVectorBase'; # new {{{ sub new { my $class = shift; my @var1 = (shift || ()); my @var2 = (shift || ()); my $v1 = eval { Statistics::Basic::Vector->new( @var1 ) } or croak $@; my $v2 = eval { Statistics::Basic::Vector->new( @var2 ) } or croak $@; my $c = $v1->_get_linked_computer( covariance => $v2 ); return $c if $c; my $this = bless({'v1'=>$v1, 'v2'=>$v2}, $class); warn "[new " . ref($this) . " v1:$this->{v1} v2:$this->{v2}]\n" if $Statistics::Basic::DEBUG >= 2; $this->{_vectors} = [ $v1, $v2 ]; $this->{m1} = eval { Statistics::Basic::Mean->new($v1) } or croak $@; $this->{m2} = eval { Statistics::Basic::Mean->new($v2) } or croak $@; $v1->_set_linked_computer( covariance => $this, $v2 ); $v2->_set_linked_computer( covariance => $this, $v1 ); return $this; } # }}} # _recalc {{{ sub _recalc { my $this = shift; my $sum = 0; my $v1 = $this->{v1}; my $v2 = $this->{v2}; my $c1 = $v1->query_size; my $c2 = $v2->query_size; warn "[recalc " . ref($this) . "] (\$c1, \$c2) = ($c1, $c2)\n" if $Statistics::Basic::DEBUG; confess "the two vectors in a " . ref($this) . " object must be the same length ($c2!=$c1)" unless $c2 == $c1; my $cardinality = $c1; $cardinality -- if $Statistics::Basic::UNBIAS; delete $this->{recalc_necessary}; delete $this->{_value}; return unless $cardinality > 0; return unless $v1->query_filled; return unless $v2->query_filled; $v1 = $v1->query; $v2 = $v2->query; my $m1 = $this->{m1}->query; my $m2 = $this->{m2}->query; if( $Statistics::Basic::DEBUG >= 2 ) { for my $i (0 .. $#$v1) { warn "[recalc " . ref($this) . "] ( $v1->[$i] - $m1 ) * ( $v2->[$i] - $m2 )\n"; } } for my $i (0 .. $#$v1) { no warnings 'uninitialized'; ## no critic $sum += ( $v1->[$i] - $m1 ) * ( $v2->[$i] - $m2 ); } $this->{_value} = ($sum / $cardinality); warn "[recalc " . ref($this) . "] ($sum/$cardinality) = $this->{_value}\n" if $Statistics::Basic::DEBUG; return; } # }}} # query_vector1 {{{ sub query_vector1 { my $this = shift; return $this->{v1}; } # }}} # query_vector2 {{{ sub query_vector2 { my $this = shift; return $this->{v2}; } # }}} # query_mean1 {{{ sub query_mean1 { my $this = shift; return $this->{m1}; } # }}} # query_mean2 {{{ sub query_mean2 { my $this = shift; return $this->{m2}; } # }}} 1; Statistics-Basic-1.6607/Basic/Median.pm0000644000175000017500000000227711706577612017500 0ustar jetterojettero package Statistics::Basic::Median; use strict; use warnings; use Carp; use base 'Statistics::Basic::_OneVectorBase'; sub new { my $class = shift; warn "[new $class]\n" if $Statistics::Basic::DEBUG >= 2; my $this = bless {}, $class; my $vector = eval { Statistics::Basic::Vector->new(@_) } or croak $@; my $c = $vector->_get_computer("median"); return $c if defined $c; $this->{v} = $vector; $vector->_set_computer( median => $this ); return $this; } sub _recalc { my $this = shift; my $v = $this->{v}; my $cardinality = $v->query_size; delete $this->{recalc_needed}; delete $this->{_value}; return unless $cardinality > 0; return unless $v->query_filled; # only applicable in certain circumstances my @v = (sort {$a <=> $b} ($v->query)); my $center = int($cardinality/2); { no warnings 'uninitialized'; ## no critic if ($cardinality%2) { $this->{_value} = $v[$center]; } else { $this->{_value} = ($v[$center] + $v[$center-1])/2; } } warn "[recalc " . ref($this) . "] vector[int($cardinality/2)] = $this->{_value}\n" if $Statistics::Basic::DEBUG; return; } 1; Statistics-Basic-1.6607/Basic/_OneVectorBase.pm0000644000175000017500000000377511706577612021145 0ustar jetterojetteropackage Statistics::Basic::_OneVectorBase; use strict; use warnings; use Carp; use Statistics::Basic; # make sure all the basic classes are loaded use overload '""' => sub { defined( my $v = $_[0]->query ) or return "n/a"; $Statistics::Basic::fmt->format_number("$v", $Statistics::Basic::IPRES) }, '0+' => sub { $_[0]->query }, ( defined($Statistics::Basic::TOLER) ? ('==' => sub { abs($_[0]-$_[1])<=$Statistics::Basic::TOLER }) : () ), 'eq' => sub { "$_[0]" eq "$_[1]" }, 'bool' => sub { 1 }, fallback => 1; # tries to do what it would have done if this wasn't present. # _recalc_needed {{{ sub _recalc_needed { my $this = shift; $this->{recalc_needed} = 1; warn "[recalc_needed " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; return; } # }}} # query {{{ sub query { my $this = shift; $this->_recalc if $this->{recalc_needed}; warn "[query " . ref($this) . " $this->{_value}]\n" if $Statistics::Basic::DEBUG; return $this->{_value}; } # }}} # query_vector {{{ sub query_vector { my $this = shift; return $this->{v}; } # }}} # query_size {{{ sub query_size { my $this = shift; return $this->{v}->query_size; } # maybe deprecate this later *size = \&query_size unless $ENV{TEST_AUTHOR}; # }}} # set_size {{{ sub set_size { my $this = shift; my $size = shift; my $nofl = shift; eval { $this->{v}->set_size($size, $nofl) } or croak $@; return $this; } # }}} # set_vector {{{ sub set_vector { my $this = shift; warn "[set_vector " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; $this->{v}->set_vector(@_); return $this; } # }}} # insert {{{ sub insert { my $this = shift; warn "[insert " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; $this->{v}->insert(@_); return $this; } # }}} # ginsert {{{ sub ginsert { my $this = shift; warn "[ginsert " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; $this->{v}->ginsert(@_); return $this; } *append = \&ginsert; # }}} 1; Statistics-Basic-1.6607/Basic/_TwoVectorBase.pm0000644000175000017500000000556511706577612021174 0ustar jetterojetteropackage Statistics::Basic::_TwoVectorBase; use strict; use warnings; use Carp; use Statistics::Basic; # make sure all the basic classes are loaded use overload '""' => sub { defined( my $v = $_[0]->query ) || return "n/a"; $Statistics::Basic::fmt->format_number("$v", $Statistics::Basic::IPRES) }, '0+' => sub { $_[0]->query }, ( defined($Statistics::Basic::TOLER) ? ('==' => sub { abs($_[0]-$_[1])<=$Statistics::Basic::TOLER }) : () ), 'eq' => sub { "$_[0]" eq "$_[1]" }, 'bool' => sub { 1 }, fallback => 1; # tries to do what it would have done if this wasn't present. # query {{{ sub query { my $this = shift; $this->_recalc if $this->{recalc_needed}; warn "[query " . ref($this) . " $this->{_value}]\n" if $Statistics::Basic::DEBUG; return $this->{_value}; } # }}} # query_size {{{ sub query_size { my $this = shift; my @v = @{$this->{_vectors}}; return ($v[0]->query_size, $v[1]->query_size); # list rather than map{} so this can be a scalar } # maybe deprecate this later *size = \&query_size unless $ENV{TEST_AUTHOR}; # }}} # set_size {{{ sub set_size { my $this = shift; my $size = shift; my $nofl = shift; eval { $_->set_size($size, $nofl) for @{$this->{_vectors}}; 1 } or croak $@; return $this; } # }}} # insert {{{ sub insert { my $this = shift; warn "[insert " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; croak ref($this) . "-insert() takes precisely two arguments. They can be arrayrefs if you like." unless 2 == int @_; my $c = 0; $_->insert( $_[$c++] ) for @{$this->{_vectors}}; return $this; } # }}} # ginsert {{{ sub ginsert { my $this = shift; warn "[ginsert " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; croak "" . ref($this) . "-ginsert() takes precisely two arguments. They can be arrayrefs if you like." unless 2 == int @_; my $c = 0; $_->ginsert( $_[$c++] ) for @{$this->{_vectors}}; my @s = $this->query_size; croak "Uneven ginsert detected, the two vectors in a " . ref($this) . " object must remain the same length." unless $s[0] == $s[1]; return $this; } *append = \&ginsert; # }}} # set_vector {{{ sub set_vector { my $this = shift; warn "[set_vector " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; croak "this set_vector() takes precisely two arguments. They can be arrayrefs if you like." unless 2 == int @_; my $c = 0; $_->set_vector( $_[$c++] ) for @{$this->{_vectors}}; my @s = $this->query_size; croak "Uneven set_vector detected, the two vectors in a " . ref($this) . " object must remain the same length." unless $s[0] == $s[1]; return $this; } # }}} # _recalc_needed {{{ sub _recalc_needed { my $this = shift; $this->{recalc_needed} = 1; warn "[recalc_needed " . ref($this) . "]\n" if $Statistics::Basic::DEBUG; return; } # }}} 1; Statistics-Basic-1.6607/Basic/Mean.pm0000644000175000017500000000203211706577612017150 0ustar jetterojettero package Statistics::Basic::Mean; use strict; use warnings; use Carp; use base 'Statistics::Basic::_OneVectorBase'; sub new { my $class = shift; warn "[new $class]\n" if $Statistics::Basic::DEBUG >= 2; my $this = bless {}, $class; my $vector = eval { Statistics::Basic::Vector->new(@_) } or croak $@; my $c = $vector->_get_computer("mean"); return $c if defined $c; $this->{v} = $vector; $vector->_set_computer( mean => $this ); return $this; } sub _recalc { my $this = shift; my $sum = 0; my $v = $this->{v}; my $cardinality = $v->query_size; delete $this->{recalc_needed}; delete $this->{_value}; return unless $cardinality > 0; return unless $v->query_filled; # only applicable in certain circumstances { no warnings 'uninitialized'; ## no critic $sum += $_ for $v->query; } $this->{_value} = ($sum / $cardinality); warn "[recalc " . ref($this) . "] ($sum/$cardinality) = $this->{_value}\n" if $Statistics::Basic::DEBUG; return; } 1; Statistics-Basic-1.6607/Basic/Variance.pm0000644000175000017500000000255211706577612020027 0ustar jetterojetteropackage Statistics::Basic::Variance; use strict; use warnings; use Carp; use base 'Statistics::Basic::_OneVectorBase'; sub new { my $class = shift; warn "[new $class]\n" if $Statistics::Basic::DEBUG >= 2; my $this = bless {}, $class; my $vector = eval { Statistics::Basic::Vector->new(@_) } or croak $@; my $c = $vector->_get_computer("variance"); return $c if defined $c; $this->{v} = $vector; $this->{m} = eval { Statistics::Basic::Mean->new($vector) } or croak $@; $vector->_set_computer( variance => $this ); return $this; } sub _recalc { my $this = shift; my $first = shift; delete $this->{recalc_needed}; delete $this->{_value}; my $mean = $this->{m}->query; return unless defined $mean; my $v = $this->{v}; my $cardinality = $v->query_size; $cardinality -- if $Statistics::Basic::UNBIAS; return unless $cardinality > 0; if( $Statistics::Basic::DEBUG >= 2 ) { warn "[recalc " . ref($this) . "] ( $_ - $mean ) ** 2\n" for $v->query; } my $sum = 0; { no warnings 'uninitialized'; ## no critic $sum += ( $_ - $mean ) ** 2 for $v->query; } $this->{_value} = ($sum / $cardinality); warn "[recalc " . ref($this) . "] ($sum/$cardinality) = $this->{_value}\n" if $Statistics::Basic::DEBUG; return; } sub query_mean { return $_[0]->{m} } 1; Statistics-Basic-1.6607/Basic/Correlation.pm0000644000175000017500000000413011706577612020552 0ustar jetterojettero package Statistics::Basic::Correlation; use strict; use warnings; use Carp; use base 'Statistics::Basic::_TwoVectorBase'; # new {{{ sub new { my $this = shift; my @var1 = (shift || ()); my @var2 = (shift || ()); my $v1 = eval { Statistics::Basic::Vector->new( @var1 ) } or croak $@; my $v2 = eval { Statistics::Basic::Vector->new( @var2 ) } or croak $@; $this = bless {}, $this; my $c = $v1->_get_linked_computer( correlation => $v2 ); return $c if $c; $this->{sd1} = eval { Statistics::Basic::StdDev->new($v1) } or croak $@; $this->{sd2} = eval { Statistics::Basic::StdDev->new($v2) } or croak $@; $this->{cov} = eval { Statistics::Basic::Covariance->new( $v1, $v2 ) } or croak $@; $this->{_vectors} = [ $v1, $v2 ]; $v1->_set_linked_computer( correlation => $this, $v2 ); $v2->_set_linked_computer( correlation => $this, $v1 ); return $this; } # }}} # _recalc {{{ sub _recalc { my $this = shift; delete $this->{recalc_needed}; delete $this->{_value}; my $c = $this->{cov}->query; return unless defined $c; my $s1 = $this->{sd1}->query; return unless defined $s1; my $s2 = $this->{sd2}->query; return unless defined $s2; if( $s1 == 0 or $s2 == 0 ) { warn "[recalc " . ref($this) . "] Standard deviation of 0. Crazy infinite correlation detected.\n" if $Statistics::Basic::DEBUG; return; } $this->{_value} = ( $c / ($s1*$s2) ); warn "[recalc " . ref($this) . "] ( $c / ($s1*$s2) ) = $this->{_value}\n" if $Statistics::Basic::DEBUG; return 1; } # }}} # query_vector1 {{{ sub query_vector1 { my $this = shift; return $this->{cov}->query_vector1; } # }}} # query_vector2 {{{ sub query_vector2 { my $this = shift; return $this->{cov}->query_vector2; } # }}} # query_mean1 {{{ sub query_mean1 { my $this = shift; return $this->{cov}->query_mean1; } # }}} # query_mean2 {{{ sub query_mean2 { my $this = shift; return $this->{cov}->query_mean2; } # }}} # query_covariance {{{ sub query_covariance { my $this = shift; return $this->{cov}; } # }}} 1; Statistics-Basic-1.6607/Makefile.PL0000644000175000017500000000135011451164567016663 0ustar jetterojettero# vi:set syntax=perl: use strict; use warnings; my @v = eval { my $b = bless {'v1'=>1, 'v2'=>2}, "blarg"; return keys %$b; }; use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Statistics::Basic', 'VERSION_FROM' => 'Basic.pm', 'PREREQ_PM' => { 'Number::Format' => 1.42, 'Scalar::Util' => 0, }, ($ExtUtils::MakeMaker::VERSION ge '6.48'? (MIN_PERL_VERSION => 5.006, META_MERGE => { keywords => ['stats','statistics', 'mean', 'average', 'correlation'], resources=> { repository => 'http://github.com/jettero/statistics--basic', }, }, LICENSE => 'LGPL', ) : ()), );