File Coverage

blib/lib/Chimaera/Matcher.pm
Criterion Covered Total %
statement 9 11 81.8
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 13 15 86.6


line stmt bran cond sub pod time code
1             package Chimaera::Matcher;
2              
3 1     1   24605 use 5.006;
  1         4  
4 1     1   5 use strict;
  1         3  
  1         23  
5 1     1   4 use warnings;
  1         7  
  1         28  
6 1     1   579 use Error;
  0            
  0            
7              
8             =head1 NAME
9              
10             Chimaera::Matcher - An object to look for Chimaeric (Bovine) MHC sequences
11              
12             =head1 VERSION
13              
14             Version 1.01
15              
16             =cut
17              
18             our $VERSION = '1.01';
19              
20             =head1 SYNOPSIS
21              
22             An object to check for possible chimaeric sequences in MHC sequencing studies.
23              
24             Example usage....
25              
26             use Chimaera::Matcher;
27              
28             my $foo = Chimaera::Matcher->new( 'haplotype1' => $haplotype1, 'haplotype2' => $haplotype2);
29            
30             if ($foo->possible_chimaera($test_seq)) {
31             printf("Could be a chimaera\n");
32             }
33             else {
34             printf("Not a chimaera\n");
35             }
36             ...
37              
38             =head1 SUBROUTINES/METHODS
39              
40             =head2 new
41              
42             Given a pair of sequence strings, construct a Matcher that we can use
43             to test a series of possible chimaeric sequences against.
44              
45             Two named sequence arguments must be supplied, keyed as 'haplotype1' and 'haplotype2'. Both must be the same length as each other and non-empty.
46              
47             Tests are all case-insensitive.
48              
49             =cut
50              
51             sub new {
52             my $invocant = shift;
53             my $class = ref($invocant) || $invocant;
54             my $self = {@_};
55             bless( $self, $class );
56             foreach my $index ( 1, 2 ) {
57             my $haplo = "haplotype${index}";
58             throw Error::Simple( "No haplotype${haplo}" )
59             unless defined( $self->{$haplo} );
60             }
61             my $len = length($self->{'haplotype1'});
62             throw Error::Simple( "Haplotypes differ in length" )
63             unless ( $len == length($self->{'haplotype2'}));
64              
65             throw Error::Simple( "Haplotypes are empty" )
66             unless ( $len > 0);
67            
68             $self->{'haplotype1'} = uc($self->{'haplotype1'});
69             $self->{'haplotype2'} = uc($self->{'haplotype2'});
70            
71             if ( $self->{'haplotype1'} eq $self->{'haplotype2'}) {
72             print "Identical\n";
73             throw Error::Simple( "Haplotypes are identical" );
74             }
75              
76             my $matcher = {};
77             for (my $i = 0; $i < $len; $i++) {
78             my $base = {};
79             $base->{substr($self->{'haplotype1'}, $i, 1 )} += 1;
80             $base->{substr($self->{'haplotype2'}, $i, 1 )} -= 1;
81            
82             $matcher->{$i} = $base;
83             }
84             $self->{'matcher'} = $matcher;
85             $self->{'length'} = $len;
86            
87             return $self;
88             }
89              
90             =head2 possible_chimaera
91              
92             Pass in a sequence to be tested as a possible chimaera. The sequence must be the same
93             length as the haplotype arguments supplied in the constructor. If the test sequence has
94             a base that was not seen in either of the haplotypes supplied, then it cannot be a
95             chimaera of the two. If the test sequence switches from one haplotype to the other more
96             than once, then this cannot be a chimaera.
97              
98             If the test sequence is identical to one or other of the input haplotypes then it also
99             cannot be defined as a chimaera.
100              
101             =cut
102              
103             sub possible_chimaera {
104             my $self = shift;
105             my $candidate = shift;
106            
107             $candidate = uc($candidate);
108            
109             my %to_string = ( 0 => "", -1 => "A", 1 => "B");
110            
111             if ( length($candidate) != $self->{'length'} ) {
112             return 0;
113             }
114            
115             my $coded_string = "";
116             for (my $i = 0; $i < $self->{'length'}; $i++) {
117             my $base = substr($candidate, $i, 1);
118             if (defined($self->{'matcher'}{$i}{$base})) {
119             $coded_string .= $to_string{$self->{'matcher'}{$i}{$base}};
120             }
121             else {
122             return 0;
123             }
124             }
125             if ($coded_string =~ m/^(A+B+|B+A+)$/) {
126             return 1;
127             }
128             return 0;
129             }
130              
131             =head1 AUTHOR
132              
133             "Andy Law", C<< <"andy.law at roslin.ed.ac.uk"> >>
134              
135             =head1 BUGS
136              
137             Please report any bugs or feature requests to C, or through
138             the web interface at L. I will be notified, and then you'll
139             automatically be notified of progress on your bug as I make changes.
140              
141              
142              
143              
144             =head1 SUPPORT
145              
146             You can find documentation for this module with the perldoc command.
147              
148             perldoc Chimaera::Matcher
149              
150              
151             You can also look for information at:
152              
153             =over 4
154              
155             =item * RT: CPAN's request tracker (report bugs here)
156              
157             L
158              
159             =item * AnnoCPAN: Annotated CPAN documentation
160              
161             L
162              
163             =item * CPAN Ratings
164              
165             L
166              
167             =item * Search CPAN
168              
169             L
170              
171             =back
172              
173              
174             =head1 ACKNOWLEDGEMENTS
175              
176              
177             =head1 LICENSE AND COPYRIGHT
178              
179             Copyright 2015 The Roslin Institute.
180              
181             This program is free software; you can redistribute it and/or modify it
182             under the terms of the the Artistic License (2.0). You may obtain a
183             copy of the full license at:
184              
185             L
186              
187             Any use, modification, and distribution of the Standard or Modified
188             Versions is governed by this Artistic License. By using, modifying or
189             distributing the Package, you accept this license. Do not use, modify,
190             or distribute the Package, if you do not accept this license.
191              
192             If your Modified Version has been derived from a Modified Version made
193             by someone other than you, you are nevertheless required to ensure that
194             your Modified Version complies with the requirements of this license.
195              
196             This license does not grant you the right to use any trademark, service
197             mark, tradename, or logo of the Copyright Holder.
198              
199             This license includes the non-exclusive, worldwide, free-of-charge
200             patent license to make, have made, use, offer to sell, sell, import and
201             otherwise transfer the Package with respect to any patent claims
202             licensable by the Copyright Holder that are necessarily infringed by the
203             Package. If you institute patent litigation (including a cross-claim or
204             counterclaim) against any party alleging that the Package constitutes
205             direct or contributory patent infringement, then this Artistic License
206             to you shall terminate on the date that such litigation is filed.
207              
208             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
209             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
210             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
211             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
212             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
213             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
214             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
215             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
216              
217              
218             =cut
219              
220             1; # End of Chimaera::Matcher