File Coverage

blib/lib/Fsdb/Filter/dbcolstatscores.pm
Criterion Covered Total %
statement 27 97 27.8
branch 0 28 0.0
condition 0 4 0.0
subroutine 9 18 50.0
pod 5 5 100.0
total 41 152 26.9


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             #
4             # dbcolstatscores.pm
5             # Copyright (C) 1997-2015 by John Heidemann
6             # $Id: f3e4ee3646cedd3f3d5ca678ebf903a6cfb51601 $
7             #
8             # This program is distributed under terms of the GNU general
9             # public license, version 2. See the file COPYING
10             # in $dblibdir for details.
11             #
12              
13             package Fsdb::Filter::dbcolstatscores;
14              
15             =head1 NAME
16              
17             dbcolstatscores - compute z-scores or t-scores for each value in a population
18              
19             =head1 SYNOPSIS
20              
21             dbcolstatscores [-t] [--tmean=MEAN] [--tstddev=STDDEV] column
22              
23             =head1 DESCRIPTION
24              
25             Compute statistics (z-score and optionally t-score) over a COLUMN of
26             numbers. Creates new columns called "zscore", "tscore".
27             T-scores are only computed if requested with the C<-t> option,
28             or if C<--tmean> or C<--tstddev> are explicitly specified
29             (defaults are mean of 50, standard deviation of 10).
30              
31             You may recall from your statistics class that a z-score is simply
32             the value normalized by mean and standard deviation, so that 0.0
33             is the mean and positive or negative values are multiples of the
34             standard deviation.
35             It assumes data follows a normal (Gaussian) distribution.
36              
37             T-score scales the z-score to match a mean of 50 and a standard
38             deviation of 10. This program allows generalized t-scores that use
39             any mean and standard deviation.
40              
41             Other scales are sometimes used as well. The Wechsler Adult
42             Intelligence Scale (one type of IQ test) is adjusted to a mean of 100
43             and a standard deviation of 15. Other tests scale to other standard
44             deviations.
45              
46             This program requires two passes over the data, and consumes
47             O(1) memory and O(number of rows) disk space.
48              
49             =head1 OPTIONS
50              
51             =over 4
52              
53             =item B<-a> or B<--include-non-numeric>
54              
55             Compute stats over all records (treat non-numeric records
56             as zero rather than just ignoring them).
57              
58             =item B<-t>
59              
60             Compute t-scores in addition to z-scores.
61              
62             =item B<--tmean MEAN>
63              
64             Use the given MEAN for t-scores.
65              
66             =item B<--tstddev STDDEV> or B<--tsd STDDEV>
67              
68             Use the given STDDEV for the standard deviation of the t-scores.
69              
70             =item B<-f FORMAT> or B<--format FORMAT>
71              
72             Specify a L-style format for output statistics.
73             Defaults to C<%.5g>.
74              
75             =item B<-T TmpDir>
76              
77             where to put tmp files.
78             Also uses environment variable TMPDIR, if -T is
79             not specified.
80             Default is /tmp.
81              
82             =back
83              
84             =for comment
85             begin_standard_fsdb_options
86              
87             This module also supports the standard fsdb options:
88              
89             =over 4
90              
91             =item B<-d>
92              
93             Enable debugging output.
94              
95             =item B<-i> or B<--input> InputSource
96              
97             Read from InputSource, typically a file name, or C<-> for standard input,
98             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
99              
100             =item B<-o> or B<--output> OutputDestination
101              
102             Write to OutputDestination, typically a file name, or C<-> for standard output,
103             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
104              
105             =item B<--autorun> or B<--noautorun>
106              
107             By default, programs process automatically,
108             but Fsdb::Filter objects in Perl do not run until you invoke
109             the run() method.
110             The C<--(no)autorun> option controls that behavior within Perl.
111              
112             =item B<--help>
113              
114             Show help.
115              
116             =item B<--man>
117              
118             Show full manual.
119              
120             =back
121              
122             =for comment
123             end_standard_fsdb_options
124              
125              
126             =head1 SAMPLE USAGE
127              
128             =head2 Input:
129              
130             #fsdb name id test1
131             a 1 80
132             b 2 70
133             c 3 65
134             d 4 90
135             e 5 70
136             f 6 90
137              
138             =head2 Command:
139              
140             cat DATA/grades.fsdb | dbcolstatscores --tmean 50 --tstddev 10 test1 | dbcolneaten
141              
142             =head2 Output:
143              
144             #fsdb name id test1 zscore tscore
145             a 1 80 0.23063 52.306
146             b 2 70 -0.69188 43.081
147             c 3 65 -1.1531 38.469
148             d 4 90 1.1531 61.531
149             e 5 70 -0.69188 43.081
150             f 6 90 1.1531 61.531
151             # | dbcolstatscores --tmean 50 --tstddev 10 test1
152             # | dbcolneaten
153              
154              
155             =head1 SEE ALSO
156              
157             L,
158             L,
159             L,
160             L
161              
162              
163             =head1 CLASS FUNCTIONS
164              
165             =cut
166              
167             @ISA = qw(Fsdb::Filter);
168             ($VERSION) = 2.0;
169              
170 1     1   4659 use strict;
  1         3  
  1         27  
171 1     1   5 use Carp;
  1         1  
  1         58  
172 1     1   5 use Pod::Usage;
  1         2  
  1         91  
173              
174 1     1   6 use Fsdb::Filter;
  1         1  
  1         22  
175 1     1   8 use Fsdb::IO::Reader;
  1         3  
  1         37  
176 1     1   6 use Fsdb::IO::Writer;
  1         2  
  1         21  
177 1     1   5 use Fsdb::Filter::dbpipeline qw(dbpipeline_open2 dbpipeline_close2_hash dbcolstats);
  1         1  
  1         53  
178 1     1   6 use Fsdb::Support qw($is_numeric_regexp);
  1         1  
  1         67  
179 1     1   7 use Fsdb::Support::NamedTmpfile;
  1         1  
  1         908  
180              
181              
182             =head2 new
183              
184             $filter = new Fsdb::Filter::dbcolstatscores(@arguments);
185              
186             Create a new dbcolstatscores object, taking command-line arguments.
187              
188             =cut
189              
190             sub new ($@) {
191 0     0 1   my $class = shift @_;
192 0           my $self = $class->SUPER::new(@_);
193 0           bless $self, $class;
194 0           $self->set_defaults;
195 0           $self->parse_options(@_);
196 0           $self->SUPER::post_new();
197 0           return $self;
198             }
199              
200              
201             =head2 set_defaults
202              
203             $filter->set_defaults();
204              
205             Internal: set up defaults.
206              
207             =cut
208              
209             sub set_defaults ($) {
210 0     0 1   my($self) = @_;
211 0           $self->SUPER::set_defaults();
212 0           $self->{_include_non_numeric} = undef;
213 0           $self->{_do_tscores} = undef;
214 0           $self->{_t_mean} = undef;
215 0           $self->{_t_stddev} = undef;
216 0           $self->{_format} = "%.5g";
217 0           $self->set_default_tmpdir;
218             }
219              
220             =head2 parse_options
221              
222             $filter->parse_options(@ARGV);
223              
224             Internal: parse command-line arguments.
225              
226             =cut
227              
228             sub parse_options ($@) {
229 0     0 1   my $self = shift @_;
230              
231 0           my(@argv) = @_;
232             $self->get_options(
233             \@argv,
234 0     0     'help|?' => sub { pod2usage(1); },
235 0     0     'man' => sub { pod2usage(-verbose => 2); },
236             'a|include-non-numeric!' => \$self->{_include_non_numeric},
237             'autorun!' => \$self->{_autorun},
238             'close!' => \$self->{_close},
239             'd|debug+' => \$self->{_debug},
240             'f|format=s' => \$self->{_format},
241 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
242             'log!' => \$self->{_logprog},
243 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
244             't!' => \$self->{_do_tscores},
245             'tmean=f' => \$self->{_t_mean},
246             'tstddev|tsd=f' => \$self->{_t_stddev},
247             'T|tmpdir|tempdir=s' => \$self->{_tmpdir},
248 0 0         ) or pod2usage(2);
249 0           $self->parse_target_column(\@argv);
250             }
251              
252             =head2 setup
253              
254             $filter->setup();
255              
256             Internal: setup, parse headers.
257              
258             =cut
259              
260             sub setup ($) {
261 0     0 1   my($self) = @_;
262              
263 0 0         pod2usage(2) if (!defined($self->{_target_column}));
264 0 0         $self->{_do_tscores} = 1 if (defined($self->{_t_mean}));
265 0 0         $self->{_do_tscores} = 1 if (defined($self->{_t_stddev}));
266 0   0       $self->{_t_mean} ||= 50.0;
267 0   0       $self->{_t_stddev} ||= 10.0;
268              
269 0           $self->finish_io_option('input', -comment_handler => $self->create_delay_comments_sub);
270 0           $self->{_target_coli} = $self->{_in}->col_to_i($self->{_target_column});
271             croak $self->{_prog} . ": target column " . $self->{_target_column} . " is not in input stream.\n"
272 0 0         if (!defined($self->{_target_coli}));
273              
274 0           $self->finish_io_option('output', -clone => $self->{_in}, -outputheader => 'delay');
275             $self->{_out}->col_create('zscore')
276 0 0         or croak $self->{_prog} . ": cannot create column zscore (maybe it already existed?)\n";
277 0 0         if ($self->{_do_tscores}) {
278             $self->{_out}->col_create('tscore')
279 0 0         or croak $self->{_prog} . ": cannot create column tscore (maybe it already existed?)\n";
280             };
281             }
282              
283             =head2 run
284              
285             $filter->run();
286              
287             Internal: run over each rows.
288              
289             =cut
290             sub run ($) {
291 0     0 1   my($self) = @_;
292              
293             #
294             # Shunt the data to a separate file.
295             #
296 0           $self->{_copy_filename} = Fsdb::Support::NamedTmpfile::alloc($self->{_tmpdir});
297             my $copy_writer = new Fsdb::IO::Writer(-file => $self->{_copy_filename},
298 0           -clone => $self->{_in});
299              
300             # and take stats
301 0           my ($stats_source_queue, $stats_sink, $stats_thread) =
302             dbpipeline_open2([-cols => [qw(data)]], dbcolstats(qw(data)));
303              
304 0           my $read_fastpath_sub = $self->{_in}->fastpath_sub();
305 0           my $target_coli = $self->{_target_coli};
306 0           my $fref;
307 0           while ($fref = &$read_fastpath_sub()) {
308             # copy and send to stats
309 0           $copy_writer->write_rowobj($fref);
310 0           $stats_sink->write_row($fref->[$target_coli]);
311             };
312             # close up both
313 0           $copy_writer->close;
314 0           my $stats_href = dbpipeline_close2_hash($stats_source_queue, $stats_sink, $stats_thread);
315 0           foreach (qw(mean stddev)) {
316             croak $self->{_prog} . ": internal error, missing stats field $_.\n"
317 0 0         if (!defined($stats_href->{$_}));
318             };
319 0           my $mean = $stats_href->{'mean'};
320 0           my $stddev = $stats_href->{'stddev'};
321              
322             #
323             # now re-open the copy and generate the new data
324             #
325             $self->{_in} = new Fsdb::IO::Reader(-file => $self->{_copy_filename},
326 0           -comment_handler => $self->create_pass_comments_sub);
327 0           my $new_target_coli = $self->{_in}->col_to_i($self->{_target_column});
328 0 0         croak $self->{_prog} . ": internal error: old and new target column numbers don't match.\n"
329             if ($target_coli != $new_target_coli);
330 0           $read_fastpath_sub = $self->{_in}->fastpath_sub(); # regenerate
331 0           my $write_fastpath_sub = $self->{_out}->fastpath_sub(); # regenerate
332 0           my $zscore_coli = $self->{_out}->col_to_i('zscore');
333 0 0         my $tscore_coli = $self->{_do_tscores} ? $self->{_out}->col_to_i('tscore') : undef;
334 0           while ($fref = &$read_fastpath_sub()) {
335 0           my $x = $fref->[$target_coli];
336 0 0         if ($x =~ /$is_numeric_regexp/) {
337 0           my $zscore = ($x - $mean) / $stddev;
338 0           $fref->[$zscore_coli] = $self->numeric_formatting($zscore);
339 0 0         if ($self->{_do_tscores}) {
340 0           my $tscore = $zscore * $self->{_t_stddev} + $self->{_t_mean};
341 0           $fref->[$tscore_coli] = $self->numeric_formatting($tscore);
342             };
343             } else {
344 0           $fref->[$zscore_coli] = '-';
345 0 0         $fref->[$tscore_coli] = '-' if ($self->{_do_tscores});
346             };
347 0           &$write_fastpath_sub($fref);
348             };
349             }
350              
351             =head1 AUTHOR and COPYRIGHT
352              
353             Copyright (C) 1991-2007 by John Heidemann
354              
355             This program is distributed under terms of the GNU general
356             public license, version 2. See the file COPYING
357             with the distribution for details.
358              
359             =cut
360              
361             1;