line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Bio::MUST::Core::SeqMask::Pmsf; |
2
|
|
|
|
|
|
|
# ABSTRACT: Posterior mean site frequencies (PMSF) for sequence sites |
3
|
|
|
|
|
|
|
$Bio::MUST::Core::SeqMask::Pmsf::VERSION = '0.212670'; |
4
|
17
|
|
|
17
|
|
130
|
use Moose; |
|
17
|
|
|
|
|
44
|
|
|
17
|
|
|
|
|
141
|
|
5
|
17
|
|
|
17
|
|
123830
|
use namespace::autoclean; |
|
17
|
|
|
|
|
47
|
|
|
17
|
|
|
|
|
173
|
|
6
|
|
|
|
|
|
|
|
7
|
17
|
|
|
17
|
|
1722
|
use autodie; |
|
17
|
|
|
|
|
43
|
|
|
17
|
|
|
|
|
165
|
|
8
|
17
|
|
|
17
|
|
94680
|
use feature qw(say); |
|
17
|
|
|
|
|
54
|
|
|
17
|
|
|
|
|
1898
|
|
9
|
|
|
|
|
|
|
|
10
|
17
|
|
|
17
|
|
141
|
use Carp; |
|
17
|
|
|
|
|
39
|
|
|
17
|
|
|
|
|
1612
|
|
11
|
17
|
|
|
17
|
|
133
|
use List::AllUtils qw(sum each_arrayref); |
|
17
|
|
|
|
|
37
|
|
|
17
|
|
|
|
|
1191
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
extends 'Bio::MUST::Core::SeqMask'; |
14
|
|
|
|
|
|
|
|
15
|
17
|
|
|
17
|
|
138
|
use Bio::MUST::Core::Types; |
|
17
|
|
|
|
|
38
|
|
|
17
|
|
|
|
|
656
|
|
16
|
17
|
|
|
17
|
|
134
|
use aliased 'Bio::MUST::Core::SeqMask::Rates'; |
|
17
|
|
|
|
|
45
|
|
|
17
|
|
|
|
|
146
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# override superclass' Bool type |
20
|
|
|
|
|
|
|
# Note: mask indices are as follow: [site][AA] |
21
|
|
|
|
|
|
|
# mask values are freqs |
22
|
|
|
|
|
|
|
has '+mask' => ( |
23
|
|
|
|
|
|
|
isa => 'ArrayRef[ArrayRef[Num]]', |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# TODO: mask non-applicable methods from superclass? (Liskov principle) |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub chi_square_stats { |
31
|
1
|
|
|
1
|
1
|
13
|
my $self = shift; |
32
|
1
|
|
|
|
|
3
|
my $othr = shift; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# check that both pmsf objects are the same length |
35
|
|
|
|
|
|
|
# potential bugs could come from constant sites etc |
36
|
1
|
|
|
|
|
45
|
my $s_width = $self->mask_len; |
37
|
1
|
|
|
|
|
38
|
my $o_width = $othr->mask_len; |
38
|
1
|
50
|
|
|
|
7
|
carp "[BMC] Warning: PMSF widths do not match: $s_width vs. $o_width!" |
39
|
|
|
|
|
|
|
unless $s_width == $o_width; |
40
|
|
|
|
|
|
|
|
41
|
1
|
|
|
|
|
4
|
my @stats; |
42
|
|
|
|
|
|
|
|
43
|
1
|
|
|
|
|
42
|
my $ea = each_arrayref [ $self->all_states ], [ $othr->all_states ]; |
44
|
1
|
|
|
|
|
2264
|
while (my ($s_freqs, $o_freqs) = $ea->() ) { |
45
|
|
|
|
|
|
|
push @stats, 0 + ( sprintf "%.13f", sum map { |
46
|
34607
|
|
|
|
|
83567
|
( $o_freqs->[$_] - $s_freqs->[$_] )**2 / $s_freqs->[$_] |
|
692140
|
|
|
|
|
2034309
|
|
47
|
|
|
|
|
|
|
} 0..$#$o_freqs ); |
48
|
|
|
|
|
|
|
} # Note: trick to get identical results across platforms |
49
|
|
|
|
|
|
|
# https://stackoverflow.com/questions/21204733/a-better-chi-square-test-for-perl |
50
|
|
|
|
|
|
|
|
51
|
1
|
|
|
|
|
98
|
return Rates->new( mask => \@stats ); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# I/O methods |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub load { |
59
|
2
|
|
|
2
|
1
|
637
|
my $class = shift; |
60
|
2
|
|
|
|
|
5
|
my $infile = shift; |
61
|
|
|
|
|
|
|
|
62
|
2
|
|
|
|
|
19
|
open my $in, '<', $infile; |
63
|
|
|
|
|
|
|
|
64
|
2
|
|
|
|
|
2504
|
my $mask = $class->new(); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
LINE: |
67
|
2
|
|
|
|
|
1910
|
while (my $line = <$in>) { |
68
|
69214
|
|
|
|
|
123029
|
chomp $line; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# skip empty lines, header line and process comment lines |
71
|
|
|
|
|
|
|
# next LINE if $line =~ $EMPTY_LINE |
72
|
|
|
|
|
|
|
# || $mask->is_comment($line); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# split line on whitespace and ignore first value (site number) |
75
|
69214
|
|
|
|
|
946539
|
my (undef, @fields) = split /\s+/xms, $line; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# store AA freqs all at once |
78
|
69214
|
|
|
|
|
2872302
|
$mask->add_state( \@fields ); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
2
|
|
|
|
|
62
|
return $mask; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
85
|
|
|
|
|
|
|
1; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
__END__ |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=pod |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=head1 NAME |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Bio::MUST::Core::SeqMask::Pmsf - Posterior mean site frequencies (PMSF) for sequence sites |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head1 VERSION |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
version 0.212670 |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 SYNOPSIS |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# TODO |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head1 DESCRIPTION |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# TODO |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head1 METHODS |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 chi_square_stats |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head2 load |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head1 AUTHOR |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Denis BAURAIN <denis.baurain@uliege.be> |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
This software is copyright (c) 2013 by University of Liege / Unit of Eukaryotic Phylogenomics / Denis BAURAIN. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
122
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=cut |