line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::TableAutoSum; |
2
|
|
|
|
|
|
|
|
3
|
10
|
|
|
10
|
|
151910
|
use strict; |
|
10
|
|
|
|
|
78
|
|
|
10
|
|
|
|
|
280
|
|
4
|
10
|
|
|
10
|
|
62
|
use warnings; |
|
10
|
|
|
|
|
21
|
|
|
10
|
|
|
|
|
581
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
require Exporter; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# I export nothing, so there aren't any @EXPORT* declarations |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.10'; |
13
|
|
|
|
|
|
|
|
14
|
10
|
|
|
10
|
|
5213
|
use Params::Validate qw/:all/; |
|
10
|
|
|
|
|
91654
|
|
|
10
|
|
|
|
|
1742
|
|
15
|
10
|
|
|
10
|
|
5313
|
use Regexp::Common; |
|
10
|
|
|
|
|
48254
|
|
|
10
|
|
|
|
|
41
|
|
16
|
10
|
|
|
10
|
|
1621207
|
use Set::Scalar; |
|
10
|
|
|
|
|
107956
|
|
|
10
|
|
|
|
|
532
|
|
17
|
10
|
|
|
10
|
|
79
|
use List::Util qw/reduce/; |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
1151
|
|
18
|
10
|
|
|
10
|
|
5038
|
use Tie::CSV_File; |
|
10
|
|
|
|
|
515005
|
|
|
10
|
|
|
|
|
862
|
|
19
|
10
|
|
|
10
|
|
5427
|
use Data::Compare; |
|
10
|
|
|
|
|
109866
|
|
|
10
|
|
|
|
|
71
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub implies($$) { |
22
|
1518
|
|
|
1518
|
0
|
95028
|
my ($x, $y) = @_; |
23
|
1518
|
|
66
|
|
|
14099
|
return !$x || ($x && $y); |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub is_uniq(@) { |
27
|
381
|
|
|
381
|
0
|
656
|
my %items; |
28
|
381
|
|
|
|
|
846
|
foreach (@_) { |
29
|
25097
|
100
|
|
|
|
53753
|
return 0 if $items{$_}++; |
30
|
|
|
|
|
|
|
} |
31
|
379
|
|
|
|
|
2918
|
return 1; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
use constant ROW_COL_TYPE => { |
35
|
|
|
|
|
|
|
type => SCALAR | ARRAYREF, |
36
|
|
|
|
|
|
|
callbacks => { |
37
|
|
|
|
|
|
|
# scalar value |
38
|
382
|
|
|
|
|
1898
|
'integer' => sub { implies !ref($_[0]) => $_[0] =~ $RE{num}{int} }, |
39
|
379
|
|
66
|
|
|
2272
|
'greater than 0' => sub { implies !ref($_[0]) => ($_[0] =~ $RE{num}{int}) && (int($_[0]) > 0) }, |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# array ref |
42
|
10
|
|
|
10
|
|
38758
|
'uniq identifiers' => sub { no strict 'refs'; |
|
10
|
|
|
|
|
41
|
|
|
10
|
|
|
|
|
948
|
|
43
|
381
|
|
|
|
|
890
|
implies ref($_[0]) => is_uniq @{$_[0]} }, |
|
381
|
|
|
|
|
1592
|
|
44
|
10
|
|
|
10
|
|
100
|
'some identifiers' => sub { no strict 'refs'; |
|
10
|
|
|
|
|
22
|
|
|
10
|
|
|
|
|
776
|
|
45
|
376
|
|
|
|
|
863
|
implies ref($_[0]) => @{$_[0]} } |
|
376
|
|
|
|
|
1481
|
|
46
|
|
|
|
|
|
|
} |
47
|
10
|
|
|
10
|
|
70
|
}; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
18430
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub new { |
50
|
219
|
|
|
219
|
1
|
477956
|
my $proto = shift; |
51
|
219
|
|
|
|
|
6997
|
my %arg = validate( @_ => {rows => ROW_COL_TYPE, cols => ROW_COL_TYPE} ); |
52
|
184
|
|
33
|
|
|
1288
|
my $class = ref($proto) || $proto; |
53
|
184
|
100
|
|
|
|
2001
|
my @rows = ref($arg{rows}) ? @{$arg{rows}} : (0 .. $arg{rows}-1); |
|
87
|
|
|
|
|
1886
|
|
54
|
184
|
100
|
|
|
|
1600
|
my @cols = ref($arg{cols}) ? @{$arg{cols}} : (0 .. $arg{cols}-1); |
|
87
|
|
|
|
|
1701
|
|
55
|
184
|
|
|
|
|
383
|
my %data; |
56
|
184
|
|
|
|
|
429
|
foreach my $row (@rows) { |
57
|
26847
|
|
|
|
|
35710
|
foreach my $col (@cols) { |
58
|
88042
|
|
|
|
|
160022
|
$data{$row}->{$col} = 0; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
184
|
|
|
|
|
1274
|
my $self = { |
62
|
|
|
|
|
|
|
rows => \@rows, |
63
|
|
|
|
|
|
|
rowset => Set::Scalar->new(@rows), |
64
|
|
|
|
|
|
|
cols => \@cols, |
65
|
|
|
|
|
|
|
colset => Set::Scalar->new(@cols), |
66
|
|
|
|
|
|
|
data => \%data |
67
|
|
|
|
|
|
|
}; |
68
|
184
|
|
|
|
|
307484
|
bless $self, $class; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub rows { |
72
|
17702
|
|
|
17702
|
1
|
59057
|
my $self = shift; |
73
|
17702
|
|
|
|
|
22722
|
return @{$self->{rows}}; |
|
17702
|
|
|
|
|
66723
|
|
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub cols { |
77
|
47963
|
|
|
47963
|
1
|
746603
|
my $self = shift; |
78
|
47963
|
|
|
|
|
60268
|
return @{$self->{cols}}; |
|
47963
|
|
|
|
|
148260
|
|
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub data : lvalue { |
82
|
413919
|
|
|
413919
|
1
|
4906511
|
my $self = shift; |
83
|
|
|
|
|
|
|
my ($row, $col, $value) = validate_pos( @_, |
84
|
|
|
|
|
|
|
{type => SCALAR, |
85
|
413919
|
|
|
413919
|
|
1072053
|
callbacks => {'is a row' => sub {$self->{rowset}->contains(shift())}} |
86
|
|
|
|
|
|
|
}, |
87
|
|
|
|
|
|
|
{type => SCALAR, |
88
|
413863
|
|
|
413863
|
|
5442818
|
callbacks => {'is a col' => sub {$self->{colset}->contains(shift())}} |
89
|
|
|
|
|
|
|
}, |
90
|
413919
|
|
|
|
|
4243258
|
0 |
91
|
|
|
|
|
|
|
); |
92
|
413807
|
100
|
|
|
|
5447044
|
$self->{data}->{$row}->{$col} = $value if defined $value; |
93
|
413807
|
|
|
|
|
1406352
|
$self->{data}->{$row}->{$col}; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub as_string { |
97
|
77
|
|
|
77
|
1
|
14225
|
my $self = shift; |
98
|
77
|
|
|
|
|
243
|
my $output = join "\t", "", $self->cols, "Sum\n"; |
99
|
77
|
|
|
|
|
581
|
foreach my $row ($self->rows) { |
100
|
10331
|
|
|
|
|
18378
|
$output .= $row . "\t"; |
101
|
10331
|
|
|
|
|
17129
|
$output .= join "\t", map {$self->data($row,$_)} ($self->cols); |
|
32631
|
|
|
|
|
56871
|
|
102
|
10331
|
|
|
|
|
24958
|
$output .= "\t" . $self->rowresult($row) . "\n"; |
103
|
|
|
|
|
|
|
} |
104
|
77
|
|
|
|
|
1417
|
$output .= join "\t", "Sum", map {$self->colresult($_)} $self->cols; |
|
10599
|
|
|
|
|
18521
|
|
105
|
77
|
|
|
|
|
1499
|
$output .= "\t" . $self->totalresult . "\n"; |
106
|
77
|
|
|
|
|
3858
|
return $output; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub store { |
110
|
29
|
|
|
29
|
1
|
593
|
local $| = 1; |
111
|
29
|
|
|
|
|
81
|
my ($self, $filename) = @_; |
112
|
29
|
100
|
|
|
|
7314
|
open FILE, ">$filename" or die "Can't open $filename to store the table"; |
113
|
28
|
|
|
|
|
231
|
print FILE $self->as_string; |
114
|
28
|
|
|
|
|
2761
|
close FILE; |
115
|
28
|
|
|
|
|
283
|
return $self; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub read { |
119
|
15
|
|
|
15
|
1
|
644
|
my ($class, $filename) = @_; |
120
|
15
|
|
|
|
|
131
|
tie my @data, 'Tie::CSV_File', $filename, sep_char => "\t", |
121
|
|
|
|
|
|
|
quote_char => undef, |
122
|
|
|
|
|
|
|
escape_char => undef; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
125
|
14
|
|
|
|
|
6976
|
my @header = @{ $data[0] }; |
|
14
|
|
|
|
|
121
|
|
126
|
14
|
|
|
|
|
13594
|
my @col = @header[1 .. $#header-1]; |
127
|
14
|
|
|
|
|
98
|
my @row = map {$data[$_]->[0]} (1 .. $#data-1); |
|
2064
|
|
|
|
|
419121
|
|
128
|
14
|
|
|
|
|
4006
|
my $table = $class->new(rows => \@row, cols => \@col); |
129
|
|
|
|
|
|
|
|
130
|
14
|
|
|
|
|
57
|
foreach my $i (0 .. $#row) { |
131
|
2064
|
|
|
|
|
4924
|
foreach my $j (0 .. $#col) { |
132
|
6518
|
|
|
|
|
25492
|
$table->data($row[$i],$col[$j]) = $data[$i+1][$j+1]; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
14
|
|
|
|
|
107
|
untie @data; |
137
|
14
|
|
|
|
|
3188
|
return $table; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub change { |
141
|
51
|
|
|
51
|
1
|
3581
|
my ($self, $sub) = @_; |
142
|
51
|
|
|
|
|
159
|
foreach my $row ($self->rows) { |
143
|
7226
|
|
|
|
|
13746
|
foreach my $col ($self->cols) { |
144
|
22815
|
|
|
|
|
40720
|
local $_ = $self->data($row,$col); |
145
|
22815
|
|
|
|
|
50165
|
&$sub; |
146
|
22813
|
|
|
|
|
124629
|
$self->data($row,$col) = $_; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub merge { |
152
|
14
|
|
|
14
|
1
|
142
|
my ($class, $sub, $table1, $table2) = @_; |
153
|
14
|
|
|
|
|
54
|
my @row = $table1->rows; |
154
|
14
|
|
|
|
|
48
|
my @col = $table1->cols; |
155
|
14
|
|
|
|
|
63
|
my $merged = $class->new(rows => \@row, cols => \@col); |
156
|
14
|
|
|
|
|
43
|
foreach my $i (@row) { |
157
|
2064
|
|
|
|
|
3232
|
foreach my $j (@col) { |
158
|
6518
|
|
|
|
|
12117
|
$merged->data($i,$j) = $sub->($table1->data($i,$j), $table2->data($i,$j)); |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
} |
161
|
14
|
|
|
|
|
356
|
return $merged; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub _calc_data { |
165
|
29405
|
|
|
29405
|
|
46185
|
my $result = $_[0]; |
166
|
29405
|
|
|
|
|
88352
|
$result += $_[$_] for (1 .. $#_); |
167
|
29405
|
|
|
|
|
82424
|
return $result; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub rowresult { |
171
|
14459
|
|
|
14459
|
1
|
41290
|
my ($self, $row) = @_; |
172
|
14459
|
|
|
|
|
24554
|
return _calc_data( map {$self->data($row,$_)} $self->cols ); |
|
45667
|
|
|
|
|
88688
|
|
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub colresult { |
176
|
14827
|
|
|
14827
|
1
|
42750
|
my ($self, $col) = @_; |
177
|
14827
|
|
|
|
|
24828
|
return _calc_data( map {$self->data($_,$col)} $self->rows ); |
|
45667
|
|
|
|
|
80365
|
|
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub totalresult { |
181
|
119
|
|
|
119
|
1
|
428
|
my $self = shift; |
182
|
119
|
|
|
|
|
189
|
return _calc_data( map {values %$_} values %{$self->{data}} ); |
|
16523
|
|
|
|
|
39222
|
|
|
119
|
|
|
|
|
1107
|
|
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub contains_row { |
186
|
2089
|
|
|
2089
|
1
|
24799
|
my ($self, $row) = @_; |
187
|
2089
|
|
|
|
|
3605
|
$self->{rowset}->contains($row); |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub contains_col { |
191
|
2089
|
|
|
2089
|
1
|
26213
|
my ($self, $col) = @_; |
192
|
2089
|
|
|
|
|
3490
|
$self->{colset}->contains($col); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub is_equal { |
196
|
155
|
|
|
155
|
1
|
1023
|
my ($self, $other) = @_; |
197
|
155
|
100
|
100
|
|
|
426
|
Compare( [$self->rows], [$other->rows] ) && |
198
|
|
|
|
|
|
|
Compare( [$self->cols], [$other->cols] ) or return 0; |
199
|
121
|
|
|
|
|
601564
|
foreach my $row ($self->rows) { |
200
|
8118
|
|
|
|
|
15991
|
foreach my $col ($self->cols) { |
201
|
64969
|
100
|
|
|
|
117739
|
$self->data($row,$col) == $other->data($row,$col) or return 0; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
64
|
|
|
|
|
1190
|
1; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
1; |
208
|
|
|
|
|
|
|
__END__ |