| blib/lib/Statistics/ANOVA/Page.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % |
| statement | 75 | 88 | 85.2 |
| branch | 5 | 10 | 50.0 |
| condition | 2 | 5 | 40.0 |
| subroutine | 19 | 22 | 86.3 |
| pod | 7 | 7 | 100.0 |
| total | 108 | 132 | 81.8 |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Statistics::ANOVA::Page; | ||||||
| 2 | |||||||
| 3 | 2 | 2 | 27029 | use 5.006; | |||
| 2 | 4 | ||||||
| 4 | 2 | 2 | 6 | use strict; | |||
| 2 | 2 | ||||||
| 2 | 41 | ||||||
| 5 | 2 | 2 | 10 | use warnings FATAL => 'all'; | |||
| 2 | 4 | ||||||
| 2 | 76 | ||||||
| 6 | 2 | 2 | 6 | use base qw(Statistics::Data); | |||
| 2 | 2 | ||||||
| 2 | 1058 | ||||||
| 7 | 2 | 2 | 44439 | use Carp qw(croak); | |||
| 2 | 5 | ||||||
| 2 | 103 | ||||||
| 8 | 2 | 2 | 8 | use List::AllUtils qw(sum0); | |||
| 2 | 2 | ||||||
| 2 | 67 | ||||||
| 9 | 2 | 2 | 1899 | use Math::Cephes qw(:dists); | |||
| 2 | 8724 | ||||||
| 2 | 500 | ||||||
| 10 | 2 | 2 | 831 | use Statistics::Data::Rank; | |||
| 2 | 5020 | ||||||
| 2 | 51 | ||||||
| 11 | 2 | 2 | 941 | use Statistics::Zed; | |||
| 2 | 3530 | ||||||
| 2 | 1185 | ||||||
| 12 | $Statistics::ANOVA::Page::VERSION = '0.02'; | ||||||
| 13 | |||||||
| 14 | =head1 NAME | ||||||
| 15 | |||||||
| 16 | Statistics::ANOVA::Page - Nonparametric analysis of variance by ranks for trend across repeatedly measured variables (Page and sign tests). | ||||||
| 17 | |||||||
| 18 | =head1 VERSION | ||||||
| 19 | |||||||
| 20 | This is documentation for B |
||||||
| 21 | |||||||
| 22 | =head1 SYNOPSIS | ||||||
| 23 | |||||||
| 24 | use Statistics::ANOVA::Page; | ||||||
| 25 | my $page = Statistics::ANOVA::Page->new(); | ||||||
| 26 | $page->load({1 => [2, 4, 6], 2 => [3, 3, 12], 3 => [5, 7, 11, 16]}); # note ordinal datanames | ||||||
| 27 | my $l_value = $page->observed(); # or expected(), variance() | ||||||
| 28 | my ($z_value, $p_value) = $page->zprob_test(ccorr => 2, tails => 1); | ||||||
| 29 | # or without pre-loading: | ||||||
| 30 | $l_value = $page->observed(data => {1 => [2, 4, 6], 2 => [5, 3, 12]}); | ||||||
| 31 | # or for subset of loaded data: | ||||||
| 32 | $l_value = $page->observed(lab => [1, 3]); | ||||||
| 33 | |||||||
| 34 | =head1 DESCRIPTION | ||||||
| 35 | |||||||
| 36 | Calculates Page statistics for nonparametric analysis of variance across given orders of repeatedly measured variables. Ranks are computed exactly as for the L -value read off the normal distribution. Similarly to the relationship between the Kruskal-Wallis and L |
||||||
| 37 | |||||||
| 38 | With only two groups, the test statistic is equivalent to that provided by a B |
||||||
| 39 | |||||||
| 40 | Build tests include comparison of return values with published data, viz. from Hollander and Wolfe (1999, p. 286ff); passing these tests means the results agree. | ||||||
| 41 | |||||||
| 42 | =head1 SUBROUTINES/METHODS | ||||||
| 43 | |||||||
| 44 | =head2 new | ||||||
| 45 | |||||||
| 46 | $page = Statistics::ANOVA::Page->new(); | ||||||
| 47 | |||||||
| 48 | New object for accessing methods and storing results. This "isa" Statistics::Data object. | ||||||
| 49 | |||||||
| 50 | =head2 load, add, unload | ||||||
| 51 | |||||||
| 52 | $page->load(1 => [1, 4], 2 => [3, 7]); | ||||||
| 53 | |||||||
| 54 | The given data can now be used by any of the following methods. This is inherited from L |
||||||
| 55 | |||||||
| 56 | =head2 observed | ||||||
| 57 | |||||||
| 58 | $val = $page->observed(); # data pre-loaded | ||||||
| 59 | $val = $page->observed(data => $hashref_of_arefs); | ||||||
| 60 | |||||||
| 61 | Returns the observed statistic I |
||||||
| 62 | |||||||
| 63 | Optionally, if the data have not been pre-loaded, send as named argument B. | ||||||
| 64 | |||||||
| 65 | =cut | ||||||
| 66 | |||||||
| 67 | sub observed { | ||||||
| 68 | 1 | 1 | 1 | 489 | my ( $self, %args ) = @_; | ||
| 69 | 1 | 4 | return _calc_l_value( _get_data( $self, %args ) ); | ||||
| 70 | } | ||||||
| 71 | |||||||
| 72 | =head2 observed_r | ||||||
| 73 | |||||||
| 74 | $val = $page->observed_r(); # data pre-loaded | ||||||
| 75 | $val = $page->observed_r(data => $hashref_of_arefs); | ||||||
| 76 | |||||||
| 77 | This implements a "l2r" transformation: Hollander and Wolfe (1999) describe how Page's I |
||||||
| 78 | |||||||
| 79 | =cut | ||||||
| 80 | |||||||
| 81 | sub observed_r { | ||||||
| 82 | 0 | 0 | 1 | 0 | my ( $self, %args ) = @_; | ||
| 83 | 0 | 0 | return _calc_l2r_value( _get_data( $self, %args ) ); | ||||
| 84 | } | ||||||
| 85 | |||||||
| 86 | =head2 expected | ||||||
| 87 | |||||||
| 88 | $val = $page->expected(); # data pre-loaded | ||||||
| 89 | $val = $page->expected(data => $hashref_of_arefs); | ||||||
| 90 | |||||||
| 91 | Returns the expected value of the I |
||||||
| 92 | |||||||
| 93 | =cut | ||||||
| 94 | |||||||
| 95 | sub expected { | ||||||
| 96 | 1 | 1 | 1 | 7 | my ( $self, %args ) = @_; | ||
| 97 | 1 | 2 | return _calc_l_exp( _get_data( $self, %args ) ); | ||||
| 98 | } | ||||||
| 99 | |||||||
| 100 | =head2 variance | ||||||
| 101 | |||||||
| 102 | $val = $page->variance(); # data pre-loaded | ||||||
| 103 | $val = $page->variance(data => $hashref_of_arefs); | ||||||
| 104 | |||||||
| 105 | Return the variance expected to occur in the I |
||||||
| 106 | |||||||
| 107 | =cut | ||||||
| 108 | |||||||
| 109 | sub variance { | ||||||
| 110 | 1 | 1 | 1 | 5 | my ( $self, %args ) = @_; | ||
| 111 | 1 | 3 | return _calc_l_var( _get_data( $self, %args ) ); | ||||
| 112 | } | ||||||
| 113 | |||||||
| 114 | =head2 zprob_test | ||||||
| 115 | |||||||
| 116 | $p_val = $page->zprob_test(); # data pre-loaded | ||||||
| 117 | $p_val = $page->zprob_test(data => $hashref_of_arefs); | ||||||
| 118 | ($z_val, $p_val) = $page->zprob_test(); # get z-score too | ||||||
| 119 | |||||||
| 120 | Calculates an expected I -value is read off the normal distribution. This is appropriate for "large" samples. Optional arguments are B |
||||||
| 121 | |||||||
| 122 | =cut | ||||||
| 123 | |||||||
| 124 | sub zprob_test { | ||||||
| 125 | 1 | 1 | 1 | 5 | my ( $self, %args ) = @_; | ||
| 126 | 1 | 16 | my $href = _get_data( $self, %args ); | ||||
| 127 | 1 | 6 | my $zed = Statistics::Zed->new(); | ||||
| 128 | 1 | 20 | my ( $z_value, $p_value ) = $zed->z_value( | ||||
| 129 | observed => _calc_l_value($href), | ||||||
| 130 | expected => _calc_l_exp($href), | ||||||
| 131 | variance => _calc_l_var($href), | ||||||
| 132 | %args | ||||||
| 133 | ); | ||||||
| 134 | 1 | 50 | 149 | return wantarray ? ( $z_value, $p_value ) : $p_value; | |||
| 135 | } | ||||||
| 136 | |||||||
| 137 | =head2 chiprob_test | ||||||
| 138 | |||||||
| 139 | $p_val = $page->chiprob_test(); # data pre-loaded | ||||||
| 140 | $p_val = $page->chiprob_test(data => $hashref_of_arefs); | ||||||
| 141 | ($chi_val, $df, $num, $p_val) = $page->chiprob_test(); | ||||||
| 142 | |||||||
| 143 | Calculates a chi-square statistic based on the observed value of I -value alone. Called in list context, returns the chi-square value, the degrees-of-freedom, number of observations, and then the I -value. |
||||||
| 144 | |||||||
| 145 | =cut | ||||||
| 146 | |||||||
| 147 | sub chiprob_test { | ||||||
| 148 | 1 | 1 | 1 | 778 | my ( $self, %args ) = @_; | ||
| 149 | 1 | 2 | my $data_href = _get_data( $self, %args ); | ||||
| 150 | 1 | 3 | my $l = _calc_l_value($data_href); | ||||
| 151 | 1 | 3 | my $n_bt = scalar keys %{$data_href}; | ||||
| 1 | 2 | ||||||
| 152 | 1 | 9 | my $n_wt = __PACKAGE__->equal_n( data => $data_href ); | ||||
| 153 | 1 | 20 | my $num = ( ( 12 * $l ) - ( 3 * $n_wt * $n_bt ) * ( $n_bt + 1 )**2 )**2; | ||||
| 154 | 1 | 2 | my $den = ( ( $n_wt * $n_bt**2 ) * ( $n_bt**2 - 1 ) * ( $n_bt + 1 ) ); | ||||
| 155 | 1 | 50 | 3 | croak 'Chi-square probability test not available given limited number of observations' if ! $den; | |||
| 156 | 1 | 2 | my $chi = $num / $den; | ||||
| 157 | 1 | 17 | my $p_value = _set_tails( chdtrc( 1, $chi ), $args{'tails'} ); # Math::Cephes fn | ||||
| 158 | 1 | 50 | 4 | return wantarray ? ( $chi, 1, ( $n_bt * $n_wt ), $p_value ) : $p_value; | |||
| 159 | } | ||||||
| 160 | |||||||
| 161 | =head2 chiprob_str | ||||||
| 162 | |||||||
| 163 | $str = $page->chiprob_str(data => HOA, correct_ties => 1); | ||||||
| 164 | |||||||
| 165 | Performs L |
||||||
| 166 | |||||||
| 167 | =cut | ||||||
| 168 | |||||||
| 169 | sub chiprob_str { | ||||||
| 170 | 0 | 0 | 1 | 0 | my ( $self, %args ) = @_; | ||
| 171 | 0 | 0 | my ( $chi_value, $df, $count, $p_value ) = $self->chiprob_test(%args); | ||||
| 172 | 0 | 0 | return "chi^2($df, N = $count) = $chi_value, p = $p_value"; | ||||
| 173 | } | ||||||
| 174 | |||||||
| 175 | sub _calc_l_value { | ||||||
| 176 | 3 | 3 | 3 | my $data = shift; | |||
| 177 | 3 | 12 | my $ranks = Statistics::Data::Rank->sum_of_ranks_within( data => $data ); | ||||
| 178 | 3 | 1069 | my $c = 0; | ||||
| 179 | return sum0( | ||||||
| 180 | 15 | 19 | map { ++$c * $ranks->{$_} } | ||||
| 181 | 3 | 4 | sort { $a <=> $b } keys %{$ranks} | ||||
| 23 | 18 | ||||||
| 3 | 8 | ||||||
| 182 | ); | ||||||
| 183 | } | ||||||
| 184 | |||||||
| 185 | sub _calc_l2r_value { | ||||||
| 186 | 0 | 0 | 0 | my $data = shift; | |||
| 187 | 0 | 0 | my $l = _calc_l_value($data); | ||||
| 188 | 0 | 0 | my $n_bt = scalar keys %{$data}; | ||||
| 0 | 0 | ||||||
| 189 | 0 | 0 | my $n_wt = __PACKAGE__->equal_n( data => $data ); | ||||
| 190 | 0 | 0 | return ( ( ( 12 * $l ) / ( $n_wt * $n_bt * ( $n_bt**2 - 1 ) ) ) - | ||||
| 191 | ( ( 3 * ( $n_bt + 1 ) ) / ( $n_bt - 1 ) ) ); | ||||||
| 192 | } | ||||||
| 193 | |||||||
| 194 | sub _calc_l_exp { | ||||||
| 195 | 2 | 2 | 2 | my $data = shift; | |||
| 196 | 2 | 2 | my $n_bt = scalar keys %{$data}; | ||||
| 2 | 3 | ||||||
| 197 | 2 | 7 | my $n_wt = __PACKAGE__->equal_n( data => $data ); | ||||
| 198 | 2 | 43 | return ( $n_wt * $n_bt * ( $n_bt + 1 )**2 ) / 4; | ||||
| 199 | } | ||||||
| 200 | |||||||
| 201 | sub _calc_l_var { | ||||||
| 202 | 2 | 2 | 1 | my $data = shift; | |||
| 203 | 2 | 2 | my $n_bt = scalar keys %{$data}; | ||||
| 2 | 4 | ||||||
| 204 | 2 | 5 | my $n_wt = __PACKAGE__->equal_n( data => $data ); | ||||
| 205 | 2 | 36 | return ( $n_wt * $n_bt**2 * ( $n_bt + 1 ) * ( $n_bt**2 - 1 ) ) / 144; | ||||
| 206 | } | ||||||
| 207 | |||||||
| 208 | sub _set_tails { | ||||||
| 209 | 1 | 1 | 2 | my ($p_value, $tails) = @_; | |||
| 210 | 1 | 50 | 5 | $tails ||= 2; | |||
| 211 | 1 | 50 | 33 | 7 | if (defined $tails and $tails == 1) { | ||
| 212 | 0 | 0 | $p_value /= 2; | ||||
| 213 | } | ||||||
| 214 | 1 | 2 | return $p_value; | ||||
| 215 | } | ||||||
| 216 | |||||||
| 217 | sub _get_data { | ||||||
| 218 | 5 | 5 | 4 | my ( $self, %args ) = @_; | |||
| 219 | 5 | 5 | my $hoa; | ||||
| 220 | 5 | 50 | 8 | if ( ref $args{'data'} ) { | |||
| 221 | 0 | 0 | $hoa = delete $args{'data'}; | ||||
| 222 | } | ||||||
| 223 | else { | ||||||
| 224 | 5 | 15 | $hoa = $self->get_hoa_by_lab(%args); | ||||
| 225 | } | ||||||
| 226 | 5 | 240 | return $hoa; | ||||
| 227 | } | ||||||
| 228 | |||||||
| 229 | =head1 DIAGNOSTICS | ||||||
| 230 | |||||||
| 231 | =over 4 | ||||||
| 232 | |||||||
| 233 | =item Chi-square probability test not available given limited number of observations | ||||||
| 234 | |||||||
| 235 | C |
||||||
| 236 | |||||||
| 237 | =item Equal number of observations required for calculating ranks within groups | ||||||
| 238 | |||||||
| 239 | C |
||||||
| 240 | |||||||
| 241 | =back | ||||||
| 242 | |||||||
| 243 | =head1 REFERENCES | ||||||
| 244 | |||||||
| 245 | Hollander, M., & Wolfe, D. A. (1999). I |
||||||
| 246 | |||||||
| 247 | Page, E. B. (1963). Ordered hypotheses for multiple treatments: A significance test for linear ranks. I |
||||||
| 248 | |||||||
| 249 | =head1 DEPENDENCIES | ||||||
| 250 | |||||||
| 251 | L |
||||||
| 252 | |||||||
| 253 | L |
||||||
| 254 | |||||||
| 255 | L |
||||||
| 256 | |||||||
| 257 | L |
||||||
| 258 | |||||||
| 259 | L |
||||||
| 260 | |||||||
| 261 | =head1 AUTHOR | ||||||
| 262 | |||||||
| 263 | Roderick Garton, C<< |
||||||
| 264 | |||||||
| 265 | =head1 BUGS AND LIMITATIONS | ||||||
| 266 | |||||||
| 267 | Please report any bugs or feature requests to C |
||||||
| 268 | the web interface at L |
||||||
| 269 | automatically be notified of progress on your bug as I make changes. | ||||||
| 270 | |||||||
| 271 | =head1 SUPPORT | ||||||
| 272 | |||||||
| 273 | You can find documentation for this module with the perldoc command. | ||||||
| 274 | |||||||
| 275 | perldoc Statistics::ANOVA::Page | ||||||
| 276 | |||||||
| 277 | |||||||
| 278 | You can also look for information at: | ||||||
| 279 | |||||||
| 280 | =over 4 | ||||||
| 281 | |||||||
| 282 | =item * RT: CPAN's request tracker (report bugs here) | ||||||
| 283 | |||||||
| 284 | L |
||||||
| 285 | |||||||
| 286 | =item * AnnoCPAN: Annotated CPAN documentation | ||||||
| 287 | |||||||
| 288 | L |
||||||
| 289 | |||||||
| 290 | =item * CPAN Ratings | ||||||
| 291 | |||||||
| 292 | L |
||||||
| 293 | |||||||
| 294 | =item * Search CPAN | ||||||
| 295 | |||||||
| 296 | L |
||||||
| 297 | |||||||
| 298 | =back | ||||||
| 299 | |||||||
| 300 | |||||||
| 301 | =head1 ACKNOWLEDGEMENTS | ||||||
| 302 | |||||||
| 303 | |||||||
| 304 | =head1 LICENSE AND COPYRIGHT | ||||||
| 305 | |||||||
| 306 | Copyright 2015-2017 Roderick Garton. | ||||||
| 307 | |||||||
| 308 | This program is free software; you can redistribute it and/or modify it | ||||||
| 309 | under the terms of either: the GNU General Public License as published | ||||||
| 310 | by the Free Software Foundation; or the Artistic License. | ||||||
| 311 | |||||||
| 312 | See L |
||||||
| 313 | |||||||
| 314 | |||||||
| 315 | =cut | ||||||
| 316 | |||||||
| 317 | 1; # End of Statistics::ANOVA::Page |