File Coverage

blib/lib/Statistics/FisherPitman.pm
Criterion Covered Total %
statement 61 126 48.4
branch 5 34 14.7
condition 1 5 20.0
subroutine 13 18 72.2
pod 8 8 100.0
total 88 191 46.0


line stmt bran cond sub pod time code
1             package Statistics::FisherPitman;
2            
3 2     2   46617 use 5.008008;
  2         7  
  2         68  
4 2     2   10 use strict;
  2         5  
  2         61  
5 2     2   8 use warnings;
  2         8  
  2         60  
6 2     2   10 use Carp qw(croak);
  2         4  
  2         152  
7 2     2   11 use List::Util qw(sum);
  2         8  
  2         214  
8 2     2   2118 use Statistics::Descriptive;
  2         37082  
  2         71  
9 2     2   23 use vars qw($VERSION);
  2         5  
  2         2991  
10             $VERSION = 0.034;
11            
12             =pod
13            
14             =head1 NAME
15            
16             Statistics::FisherPitman - Randomization-based alternative to one-way independent groups ANOVA; unequal variances okay
17            
18             =head1 SYNOPSIS
19            
20             use Statistics::FisherPitman 0.034;
21            
22             my @dat1 = (qw/12 12 14 15 12 11 15/);
23             my @dat2 = (qw/13 14 18 19 22 21 26/);
24            
25             my $fishpit = Statistics::FisherPitman->new();
26             $fishpit->load({d1 => \@dat1, d2 => \@dat2});
27            
28             # Oh, more data just came in:
29             my @dat3 = (qw/11 7 7 2 19 19/);
30             $fishpit->add({d3 => \@dat3});
31            
32             my $T = $fishpit->t_value();
33             # now go to monte carlo to get a p for your T
34            
35             # or get a t_value and p_value in one by randomization test:
36             $fishpit->p_value(resamplings => 1000)->dump(title => "A test");
37            
38             =head1 DESCRIPTION
39            
40             Tests for a difference between independent samples. It is commonly recommended as an alternative to the oneway independent groups ANOVA when variances are unequal, as its test-statistic, I, is not dependent on an estimate of variance. As a randomization test, it is "distribution-free", with the probability of obtaining the observed value of I being derived from the data themselves.
41            
42             =head1 METHODS
43            
44             =head2 new
45            
46             $fishpit = Statistics::FisherPitman->new()
47            
48             Class constructor; expects nothing.
49            
50             =cut
51            
52             #-----------------------------------------------------------------------
53             sub new {
54             #-----------------------------------------------------------------------
55 1     1 1 27 my $proto = shift;
56 1   33     6 my $class = ref($proto) || $proto;
57 1         2 my $self= {};
58             ##$self->{$_} = '' foreach qw/df_t df_e f_value chi_value p_value ss_t ss_e title/;
59 1         2 bless($self, $class);
60 1         3 return $self;
61             }
62            
63             =head2 load
64            
65             $fishpit->load('aname', @data1)
66             $fishpit->load('aname', \@data1)
67             $fishpit->load({'aname' => \@data1, 'another_name' => \@data2})
68            
69             I: C
70            
71             Accepts either (1) a single C value> pair of a sample name, and a list (referenced or not) of data; or (2) a hash reference of named array references of data. The data are loaded into the class object by name, within a hash named C, as L objects. So you can easily get at any descriptives for the groups you've loaded - e.g., $fishpit->{'data'}->{'aname'}->mean() - or you could get at the data again by going $fishpit->{'data'}->{'aname'}->get_data(); and so on. The names of the data are up to you.
72            
73             Each call Ls any previous loads.
74            
75             Returns the Statistics::FisherPitman object.
76            
77             =cut
78            
79             #-----------------------------------------------------------------------
80             sub load {
81             #-----------------------------------------------------------------------
82 1     1 1 12 my $self = shift;
83 1         5 $self->unload();
84 1         4 $self->add(@_);
85             }
86             *load_data = \&load; # Alias
87            
88            
89             =head2 add
90            
91             $fishpit->add('another_name', @data2)
92             $fishpit->add('another_name', \@data2)
93             $fishpit->add({'another_name' => \@data2})
94            
95             I: C
96            
97             Same as L except that any previous loads are not Led.
98            
99             =cut
100            
101             #-----------------------------------------------------------------------
102             sub add {
103             #-----------------------------------------------------------------------
104 1     1 1 3 my $self = shift;
105            
106 1 50       3 if (ref $_[0] eq 'HASH') {
107 1         2 while (my ($sample_name, $sample_data) = each %{$_[0]}) {
  3         264  
108 2 50       7 if (ref $sample_data) {
109 2         12 $self->{'data'}->{$sample_name} = Statistics::Descriptive::Full->new();
110 2         133 $self->{'data'}->{$sample_name}->add_data(@{$sample_data});
  2         9  
111             }
112             }
113             }
114             else {
115 0         0 my $sample_name = shift;
116 0 0       0 my $sample_data = ref $_[0] eq 'ARRAY' ? $_[0] : scalar (@_) ? \@_ : croak 'No list of data';
    0          
117 0         0 $self->{'data'}->{$sample_name} = Statistics::Descriptive::Full->new();
118 0         0 $self->{'data'}->{$sample_name}->add_data(@{$sample_data});
  0         0  
119             }
120             }
121             *add_data = \&add; # Alias
122            
123             =head2 unload
124            
125             $fishpit->unload();
126            
127             Empties all cached data and calculations upon them, ensuring these will not be used for testing. This will be automatically called with each new load, but, to take care of any development, it could be good practice to call it yourself whenever switching from one dataset for testing to another.
128            
129             =cut
130            
131             #-----------------------------------------------------------------------
132             sub unload {
133             #-----------------------------------------------------------------------
134 1     1 1 3 my $self = shift;
135 1         6 $self->{'data'} = {};
136 1         12 $self->{$_} = undef foreach qw/df_t df_e f_value chi_value p_value ss_t ss_e ms_t ms_e conf_int/;
137             }
138            
139             =head2 t_value
140            
141             $fishpit->t_value()
142            
143             Returns a Fisher-Pitman T-value for the loaded data, and lumps the value into the class object for the key I.
144            
145             I is calculated as follows:
146            
147             =for html

          g
 T =  SUM  ni xi²
        i = 1
148            
149             which pertains to the Iumber of observations in each I of I samples, and
150            
151             =for html

                 ni
 xi =  1/ni SUM  xij
               j = 1
152            
153             (for each I observation in the I sample).
154            
155             =cut
156            
157             #-----------------------------------------------------------------------
158             sub t_value {
159             #-----------------------------------------------------------------------
160 1     1 1 359 my ($self, %args) = @_;
161 1 50       8 my %data = ref $args{'data'} eq 'HASH' ? %{$args{'data'}} : ref $self->{'data'} eq 'HASH' ? %{$self->{'data'}} : croak 'No reference to a hash of data for performing ANOVA';
  0 50       0  
  1         4  
162 1         3 my (%lens, @dat, %orig) = ();
163            
164 1         4 foreach (keys %data) {
165 2 50       29 $lens{$_} = $data{$_}->count or croak 'Empty data sent to Fisher-Pitman test';
166 2         17 $orig{$_} = [$data{$_}->get_data];
167 2         28 push @dat, $data{$_}->get_data;
168             }
169            
170 1         15 my $T = _get_T(\%orig);
171 1         2 $self->{'t_value'} = $T;
172            
173 1         7 return $T;
174             }
175            
176             =head2 p_value
177            
178             $fishpit->p_value(resamplings => 'non-negative number')
179            
180             I: test
181            
182             With a positive value for I, the loaded data will be shuffled so many times, and the T-value calculated for each resampling. The proportion of T-values in these resamplings that are greater than I the T-value of the original data, as loaded, is the I for basing significance considerations upon.
183            
184             Randomization test is simply based on pooling all the data and, for each resampling, giving them a Fisher-Yates shuffle, and distributing them to so many groups, of so many sample-sizes, as in the original dataset.
185            
186             The class object is fed the values for C and C. Confidence interval (95%) of the true proportion (p-value) is also calculated and stored as a two-element array named C. The method returns only itself. So you can get at these values thus:
187            
188             print "T = $fishpit->{'t_value'}, p = $fishpit->{'p_value'}\n";
189             print '95% confidence interval for the proportion of Ts greater than or equal to the observed value ranges from ';
190             print "$fishpit->{'conf_int'}->[0] to $fishpit->{'conf_int'}->[1].\n";
191            
192             =cut
193            
194             #-----------------------------------------------------------------------
195             sub p_value {
196             #-----------------------------------------------------------------------
197 0     0 1 0 my ($self, %args) = @_;
198 0 0       0 my %data = ref $args{'data'} eq 'HASH' ? %{$args{'data'}} : ref $self->{'data'} eq 'HASH' ? %{$self->{'data'}} : croak 'No reference to a hash of data for performing ANOVA';
  0 0       0  
  0         0  
199            
200 0         0 my (%lens, @dat, %orig) = ();
201 0         0 foreach (keys %data) {
202 0         0 $orig{$_} = [$data{$_}->get_data];
203 0         0 push @dat, $data{$_}->get_data;
204 0 0       0 $lens{$_} = $data{$_}->count or croak 'Empty data sent to Fisher-Pitman test';
205             }
206            
207 0         0 my $T = _get_T(\%orig);
208 0         0 $self->{'t_value'} = $T;
209            
210 0   0     0 my $resamplings = $args{'resamplings'} || return $self;
211            
212 0         0 my ($n_gteq, $name, @ari, @perm, %rands) = (0);
213            
214 0         0 foreach (1 .. $resamplings) {
215 0         0 _fy_shuffle(\@dat);
216 0         0 @perm = @dat;
217 0         0 foreach $name(keys %data) {
218 0         0 @ari = ();
219 0         0 for (1 .. $lens{$name}) {
220 0         0 push @ari, shift @perm;
221             }
222 0         0 $rands{$name} = [@ari];
223             }
224 0 0       0 $n_gteq++ if _get_T(\%rands) >= $T;
225 0         0 %rands = ();
226             }
227 0         0 my $p = $n_gteq / $resamplings;
228 0         0 $self->{'p_value'} = $p;
229 0         0 $self->{'conf_int'} = _conf_int($n_gteq, $resamplings);
230 0         0 return $self;
231             }
232             *test = \&p_value; # Alias
233            
234             =head2 dump
235            
236             $fishpit->dump(title => 'A test of something', conf_int => 1|0, precision_p => integer)
237            
238             Prints a line to STDOUT of the form I. Above this string, a title can also be printed, by giving a value to the optional I argument. The 95% confidence interval, and the precision of the p-value(s), can also be optionally dumped, as above. Ends with a line-break, i.e., "\n". </td> </tr> <tr> <td class="h" > <a name="239">239</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="240">240</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="241">241</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="242">242</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #----------------------------------------------------------------------- </td> </tr> <tr> <td class="h" > <a name="243">243</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub dump { </td> </tr> <tr> <td class="h" > <a name="244">244</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #----------------------------------------------------------------------- </td> </tr> <tr> <td class="h" > <a name="245">245</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--subroutine.html#245-1"> 0 </a> </td> <td class="c3" > <a href="blib-lib-Statistics-FisherPitman-pm--subroutine.html#245-1"> 1 </a> </td> <td > 0 </td> <td class="s"> my ($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="246">246</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--branch.html#246-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> print "$args{'title'}\n" if $args{'title'}; </td> </tr> <tr> <td class="h" > <a name="247">247</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> print $self->string(%args); </td> </tr> <tr> <td class="h" > <a name="248">248</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> print "\n"; </td> </tr> <tr> <td class="h" > <a name="249">249</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="250">250</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="251">251</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head2 string </td> </tr> <tr> <td class="h" > <a name="252">252</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="253">253</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $fishpit->string(conf_int => 1|0, precision_p => integer) </td> </tr> <tr> <td class="h" > <a name="254">254</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="255">255</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Returns a line of the form I<T = t_value, p = p_value>, to the precision specified (if any), and, optionally, with the confidence-interval for the p-value appended. </td> </tr> <tr> <td class="h" > <a name="256">256</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="257">257</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="258">258</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="259">259</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #----------------------------------------------------------------------- </td> </tr> <tr> <td class="h" > <a name="260">260</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub string { </td> </tr> <tr> <td class="h" > <a name="261">261</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #----------------------------------------------------------------------- </td> </tr> <tr> <td class="h" > <a name="262">262</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--subroutine.html#262-1"> 0 </a> </td> <td class="c3" > <a href="blib-lib-Statistics-FisherPitman-pm--subroutine.html#262-1"> 1 </a> </td> <td > 0 </td> <td class="s"> my ($self, %args) = @_; </td> </tr> <tr> <td class="h" > <a name="263">263</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> my $str = ''; </td> </tr> <tr> <td class="h" > <a name="264">264</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $str .= "T = $self->{'t_value'}"; </td> </tr> <tr> <td class="h" > <a name="265">265</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--branch.html#265-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> if (defined $self->{'p_value'}) { </td> </tr> <tr> <td class="h" > <a name="266">266</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $str .= ', p = '; </td> </tr> <tr> <td class="h" > <a name="267">267</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--branch.html#267-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $str .= $args{'precision_p'} ? sprintf('%.' . $args{'precision_p'} . 'f', $self->{'p_value'}) : $self->{'p_value'}; </td> </tr> <tr> <td class="h" > <a name="268">268</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--branch.html#268-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> if ($args{'conf_int'}) { </td> </tr> <tr> <td class="h" > <a name="269">269</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $str .= " (95% CI: "; </td> </tr> <tr> <td class="h" > <a name="270">270</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--branch.html#270-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> if ($args{'precision_p'}) { </td> </tr> <tr> <td class="h" > <a name="271">271</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $str .= sprintf('%.' . $args{'precision_p'} . 'f', $self->{'conf_int'}->[0]); </td> </tr> <tr> <td class="h" > <a name="272">272</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $str .= ', '; </td> </tr> <tr> <td class="h" > <a name="273">273</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $str .= sprintf('%.' . $args{'precision_p'} . 'f', $self->{'conf_int'}->[1]); </td> </tr> <tr> <td class="h" > <a name="274">274</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="275">275</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { </td> </tr> <tr> <td class="h" > <a name="276">276</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $str .= join(', ', @{$self->{'conf_int'}}); </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="277">277</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="278">278</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $str .= ')'; </td> </tr> <tr> <td class="h" > <a name="279">279</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="280">280</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="281">281</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> return $str; </td> </tr> <tr> <td class="h" > <a name="282">282</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="283">283</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="284">284</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub _get_T { </td> </tr> <tr> <td class="h" > <a name="285">285</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td class="c3" > <a href="blib-lib-Statistics-FisherPitman-pm--subroutine.html#285-1"> 1 </a> </td> <td >   </td> <td > 3 </td> <td class="s"> my ($data) = @_; </td> </tr> <tr> <td class="h" > <a name="286">286</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 2 </td> <td class="s"> my ($T, $xij, $count) = (0, 0); </td> </tr> <tr> <td class="h" > <a name="287">287</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 1 </td> <td class="s"> foreach (keys %{$data}) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 4 </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="288">288</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 20 </td> <td class="s"> $count = scalar(@{$data->{$_}}); </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="289">289</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 4 </td> <td class="s"> $xij = 1 / $count * sum(@{$data->{$_}}); </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="290">290</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s"> $T += $count * $xij**2 </td> </tr> <tr> <td class="h" > <a name="291">291</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="292">292</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 3 </td> <td class="s"> return $T; </td> </tr> <tr> <td class="h" > <a name="293">293</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="294">294</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="295">295</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub _conf_int { </td> </tr> <tr> <td class="h" > <a name="296">296</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--subroutine.html#296-1"> 0 </a> </td> <td >   </td> <td >   </td> <td class="s"> my ($ng, $ns) = @_; </td> </tr> <tr> <td class="h" > <a name="297">297</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $p = $ng / $ns; </td> </tr> <tr> <td class="h" > <a name="298">298</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $i = 1.96 * sqrt($p * (1 - $p) / $ns); </td> </tr> <tr> <td class="h" > <a name="299">299</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $lo = $p - $i; </td> </tr> <tr> <td class="h" > <a name="300">300</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $hi = $p + $i; </td> </tr> <tr> <td class="h" > <a name="301">301</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return [$lo, $hi]; </td> </tr> <tr> <td class="h" > <a name="302">302</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="303">303</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="304">304</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub _fy_shuffle { # fisher-yates shuffle, via Perl FAQ 4 </td> </tr> <tr> <td class="h" > <a name="305">305</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--subroutine.html#305-1"> 0 </a> </td> <td >   </td> <td >   </td> <td class="s"> my ($list) = @_; </td> </tr> <tr> <td class="h" > <a name="306">306</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $i; </td> </tr> <tr> <td class="h" > <a name="307">307</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for ($i = @$list; --$i; ) { </td> </tr> <tr> <td class="h" > <a name="308">308</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $j = int rand ($i+1); </td> </tr> <tr> <td class="h" > <a name="309">309</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Statistics-FisherPitman-pm--branch.html#309-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> next if $i == $j; </td> </tr> <tr> <td class="h" > <a name="310">310</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @$list[ $i, $j ] = @$list[ $j, $i ]; </td> </tr> <tr> <td class="h" > <a name="311">311</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="312">312</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="313">313</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="314">314</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> <tr> <td class="h" > <a name="315">315</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> __END__ </td> </tr> </table> </body> </html>