t/descr.t - metacpan.org

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 61;

use lib 't/lib';
use Utils qw/is_between compare_hash_by_ranges/;

use Benchmark;
use Statistics::Descriptive;

{
    # test #1
    my $stat = Statistics::Descriptive::Full->new();
    my @results = $stat->least_squares_fit();
    # TEST
    ok (!scalar(@results), "Least-squares results on a non-filled object are empty.");

    # test #2
    # data are y = 2*x - 1

    $stat->add_data( 1, 3, 5, 7 );
    @results = $stat->least_squares_fit();
    # TEST
    is_deeply (
        [@results[0..1]],
        [-1, 2],
        "least_squares_fit returns the correct result."
    );
}

{
    # test #3
    # test error condition on harmonic mean : one element zero
    my $stat = Statistics::Descriptive::Full->new();
    $stat->add_data( 1.1, 2.9, 4.9, 0.0 );
    my $single_result = $stat->harmonic_mean();
    # TEST
    ok (!defined($single_result),
        "harmonic_mean is undefined if there's a 0 datum."
    );
}

{
    # test #4
    # test error condition on harmonic mean : sum of elements zero
    my $stat = Statistics::Descriptive::Full->new();
    $stat->add_data( 1.0, -1.0 );
    my $single_result = $stat->harmonic_mean();
    # TEST
    ok (!defined($single_result),
        "harmonic_mean is undefined if the sum of the reciprocals is zero."
    );
}

{
    # test #5
    # test error condition on harmonic mean : sum of elements near zero
    my $stat = Statistics::Descriptive::Full->new();
    local $Statistics::Descriptive::Tolerance = 0.1;
    $stat->add_data( 1.01, -1.0 );
    my $single_result = $stat->harmonic_mean();
    # TEST
    ok (! defined( $single_result ),
        "test error condition on harmonic mean : sum of elements near zero"
    );
}

{
    # test #6
    # test normal function of harmonic mean
    my $stat = Statistics::Descriptive::Full->new();
    $stat->add_data( 1,2,3 );
    my $single_result = $stat->harmonic_mean();
    # TEST
    ok (scalar(abs( $single_result - 1.6363 ) < 0.001),
        "test normal function of harmonic mean",
    );
}

{
    # test #7
    # test stringification of hash keys in frequency distribution
    my $stat = Statistics::Descriptive::Full->new();
    $stat->add_data(0.1,
                    0.15,
                    0.16,
                   1/3);
    my %f = $stat->frequency_distribution(2);

    # TEST
    compare_hash_by_ranges(
        \%f,
        [[0.216666,0.216667,3],[0.3333,0.3334,1]],
        "Test stringification of hash keys in frequency distribution",
    );

    # test #8
    ##Test memorization of last frequency distribution
    my %g = $stat->frequency_distribution();
    # TEST
    is_deeply(
        \%f,
        \%g,
        "memorization of last frequency distribution"
    );
}

{
    # test #9
    # test the frequency distribution with specified bins
    my $stat = Statistics::Descriptive::Full->new();
    my @freq_bins=(20,40,60,80,100);
    $stat->add_data(23.92,
                    32.30,
                    15.27,
                    39.89,
                    8.96,
                    40.71,
                    16.20,
                    34.61,
                    27.98,
                    74.40);
    my %f = $stat->frequency_distribution(\@freq_bins);

    # TEST
    is_deeply(
        \%f,
        {
            20 => 3,
            40 => 5,
            60 => 1,
            80 => 1,
            100 => 0,
        },
        "Test the frequency distribution with specified bins"
    );
}

{
    # test #10 and #11
    # Test the percentile function and caching
    my $stat = Statistics::Descriptive::Full->new();
    $stat->add_data(-5,-2,4,7,7,18);
    ##Check algorithm
    # TEST
    is ($stat->percentile(50),
        4,
        "percentile function and caching - 1",
    );
    # TEST
    is ($stat->percentile(25),
        -2,
        "percentile function and caching - 2",
    );
}

{
    # tests #12 and #13
    # Check correct parsing of method parameters
    my $stat = Statistics::Descriptive::Full->new();
    $stat->add_data(1,2,3,4,5,6,7,8,9,10);
    # TEST
    is(
        $stat->trimmed_mean(0.1,0.1),
        $stat->trimmed_mean(0.1),
        "correct parsing of method parameters",
    );

    # TEST
    is ($stat->trimmed_mean(0.1,0),
        6,
        "correct parsing of method parameters - 2",
    );
}

{
    my $stat = Statistics::Descriptive::Full->new();

    $stat->add_data((0.001) x 6);

    # TEST
    is_between ($stat->variance(),
        0,
        0.00001,
        "Workaround to avoid rounding errors that yield negative variance."
    );

    # TEST
    is_between ($stat->standard_deviation(),
        0,
        0.00001,
        "Workaround to avoid rounding errors that yield negative std-dev."
    );
}

{
    my $stat = Statistics::Descriptive::Full->new();

    $stat->add_data(1, 2, 3, 5);

    # TEST
    is ($stat->count(),
        4,
        "There are 4 elements."
    );

    # TEST
    is ($stat->sum(),
        11,
        "The sum is 11",
    );

    # TEST
    is ($stat->sumsq(),
        39,
        "The sum of squares is 39"
    );

    # TEST
    is ($stat->min(),
        1,
        "The minimum is 1."
    );

    # TEST
    is ($stat->max(),
        5,
        "The maximum is 5."
    );
}

{
    # test #9
    # test the frequency distribution with specified bins
    my $stat = Statistics::Descriptive::Full->new();

    my @freq_bins=(20,40,60,80,100);

    $stat->add_data(23.92,
                    32.30,
                    15.27,
                    39.89,
                    8.96,
                    40.71,
                    16.20,
                    34.61,
                    27.98,
                    74.40);

    my $f_d = $stat->frequency_distribution_ref(\@freq_bins);

    # TEST
    is_deeply(
        $f_d,
        {
            20 => 3,
            40 => 5,
            60 => 1,
            80 => 1,
            100 => 0,
        },
        "Test the frequency distribution returned as a scalar reference"
    );
}

{
    # test #9
    # test the frequency distribution with specified bins
    my $stat = Statistics::Descriptive::Full->new();

    $stat->add_data(2, 4, 8);

    # TEST
    is_between(
        $stat->geometric_mean(),
        (4-1e-4),
        (4+1e-4),
        "Geometric Mean Test #1",
    )
}

{
    my $stat = Statistics::Descriptive::Full->new();
    my $expected;

    $stat->add_data(1 .. 9, 100);

    # TEST
    $expected = 3.11889574523909;
    is_between ($stat->skewness(),
        $expected - 1E-13,
        $expected + 1E-13,
        "Skewness of $expected +/- 1E-13"
    );

    # TEST
    $expected = 9.79924471616366;
    is_between ($stat->kurtosis(),
        $expected - 1E-13,
        $expected + 1E-13,
        "Kurtosis of $expected +/- 1E-13"
    );

    $stat->add_data(100 .. 110);

    #  now check that cached skew and kurt values are recalculated

    # TEST
    $expected = -0.306705104889384;
    is_between ($stat->skewness(),
        $expected - 1E-13,
        $expected + 1E-13,
        "Skewness of $expected +/- 1E-13"
    );

    # TEST
    $expected = -2.09839497356215;
    is_between ($stat->kurtosis(),
        $expected - 1E-13,
        $expected + 1E-13,
        "Kurtosis of $expected +/- 1E-13"
    );
}

{
    my $stat = Statistics::Descriptive::Full->new();

    $stat->add_data(1,2);
    my $def;

    # TEST
    $def = defined $stat->skewness() ? 1 : 0;
    is ($def,
        0,
        'Skewness is undef for 2 samples'
    );

    $stat->add_data (1);

    # TEST
    $def = defined $stat->kurtosis() ? 1 : 0;
    is ($def,
        0,
        'Kurtosis is undef for 3 samples'
    );

}

{
    # This is a fix for:
    # https://rt.cpan.org/Ticket/Display.html?id=72495
    # Thanks to Robert Messer
    my $stat = Statistics::Descriptive::Full->new();

    my $ret = $stat->percentile(100);

    # TEST
    ok (!defined($ret), 'Returns undef and does not die.');
}



#  test stats when no data have been added
{
    my $stat = Statistics::Descriptive::Full->new();
    my ($result, $str);

    #  An accessor method for _permitted would be handy,
    #  or one to get all the stats methods
    my @methods = qw {
        mean sum variance standard_deviation
        min mindex max maxdex sample_range
        skewness kurtosis median
        harmonic_mean geometric_mean
        mode least_squares_fit
        percentile frequency_distribution
    };
    #  least_squares_fit is handled in an earlier test, so is actually a duplicate here

    #diag 'Results are undef when no data added';
    #  need to update next line when new methods are tested here
    # TEST:$method_count=18
    foreach my $method (sort @methods) {
        $result = $stat->$method;
        # TEST*$method_count
        ok (!defined ($result), "$method is undef when object has no data.");
    }

    #  quantile and trimmed_mean require valid args, so don't test in the method loop
    my $method = 'quantile';
    $result = $stat->$method(1);
    # TEST
    ok (!defined ($result), "$method is undef when object has no data.");

    $method = 'trimmed_mean';
    $result = $stat->$method(0.1);
    # TEST
    ok (!defined ($result), "$method is undef when object has no data.");
}

#  test SD when only one value added
{
    my $stat = Statistics::Descriptive::Full->new();
    $stat->add_data( 1 );

    my $result = $stat->standard_deviation();
    # TEST
    ok ($result == 0, "SD is zero when object has one record.");
}

# Test function returns undef in list context when no data added.
# The test itself is almost redundant.
# Fixes https://rt.cpan.org/Ticket/Display.html?id=74890
{
    my $stat = Statistics::Descriptive::Full->new();

    # TEST
    is_deeply(
        [ $stat->median(), ],
        [ undef() ],
        "->median() Returns undef in list-context.",
    );

    # TEST
    is_deeply(
        [ $stat->standard_deviation(), ],
        [ undef() ],
        "->standard_deviation() Returns undef in list-context.",
    );
}

{
    my $stats = Statistics::Descriptive::Full->new();

    $stats->add_data_with_samples([{1 => 10}, {2 => 20}, {3 => 30}, {4 => 40}, {5 => 50}]);

    # TEST
    is_deeply(
        $stats->_data(),
        [ 1, 2, 3, 4, 5 ],
        'add_data_with_samples: data set is correct',
    );

    # TEST
    is_deeply(
        $stats->_samples(),
        [ 10, 20, 30, 40, 50 ],
        'add_data_with_samples: samples are correct',
    );

}

#  Tests for mindex and maxdex on unsorted data,
#  including when new data are added which should not change the values
{
    my $stats_class = 'Statistics::Descriptive::Full';
    my $stat1 = $stats_class->new();

    my @data1 = (20, 1 .. 3, 100, 1..5);
    my @data2 = (25, 30);

    my $e_maxdex = 4;
    my $e_mindex = 1;

    $stat1->add_data(@data1);     # initialise

    # TEST*2
    is ($stat1->mindex, $e_mindex, "initial mindex is correct");
    is ($stat1->maxdex, $e_maxdex, "initial maxdex is correct");

    # TEST*2
    $stat1->add_data(@data2);     #  add new data
    is ($stat1->mindex, $e_mindex, "mindex is correct after new data added");
    is ($stat1->maxdex, $e_maxdex, "maxdex is correct after new data added");

    # TEST*2
    $stat1->median;  #  trigger a sort
    $e_maxdex = scalar @data1 + scalar @data2 - 1;
    is ($stat1->mindex, 0, "mindex is correct after sorting");
    is ($stat1->maxdex, $e_maxdex, "maxdex is correct after sorting");

}


#  what happens when we add new data?
#  Recycle the same data so mean, sd etc remain the same
{
    my $stats_class = 'Statistics::Descriptive::Full';
    my $stat1 = $stats_class->new();
    my $stat2 = $stats_class->new();

    my @data1 = (1 .. 9, 100);
    my @data2 = (100 .. 110);

    #  sample of methods
    my @methods = qw /mean standard_deviation count skewness kurtosis median/;

    $stat1->add_data(@data1);     # initialise
    foreach my $meth (@methods) { #  run some methods
        $stat1->$meth;
    }
    $stat1->add_data(@data2);     #  add new data
    foreach my $meth (@methods) { #  re-run some methods
        $stat1->$meth;
    }

    $stat2->add_data(@data1, @data2);  #  initialise with all data
    foreach my $meth (@methods) { #  run some methods
        $stat2->$meth;
    }

    # TEST
    is_deeply (
        $stat1,
        $stat2,
        'stats consistent after adding new data',
    );

}
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)