Improvements to POD
[bioperl-live.git] / t / Restriction / Analysis-refac.t
blob7d7d679661cb7c1f979290394adc91abf6728f69
1 #-*-perl-*-
2 # $Id$
3 use strict;
4 use warnings;
5 use Bio::Root::Test;
6 use Bio::PrimarySeq;
8 use lib '.';
10 test_begin(-tests => 91);
12 use_ok( 'Bio::Restriction::IO' );
13 use_ok( 'Bio::Restriction::Analysis' );
14 use_ok('Bio::Restriction::EnzymeCollection');
15 use_ok('Bio::Restriction::Enzyme');
17 # recog sites (not nec. cut sites!) in lc
19 my $seq = new Bio::PrimarySeq(
20      -seq        => 'gtcGaagcttAGCAAACGGTTTCTACgacgttatcgtcATTCGGGgcaagcgTCGGCGATTCGGACGTGcacctgcAAAtGCGCGGCgTTAgcgaggtgGCGAgacttttatgtcCCCCTgaagcggttattggTTATATGGTGTTCGTgaccgaTCTAATCCATATTTATTTTTGGCAGTGCtgggtgTTACgacTCGCGA',
21      -primary_id => 'test',
22      -molecule   => 'dna'
25 # the test enzymes [rebase characterization]: 
26 # nonambig intrasite cutter: HindIII  [ A^AGCTT        ]
27 #    ambig intrasite cutter: AasI     [ GACNNNN^NNGTC  ]
28 # nonambig extrasite cutter: AarI     [ CACCTGC(4/8)   ]
29 #    ambig extrasite cutter: BceSI    [ SSAAGCG(27/27) ]
30 #    ambig center    cutter: AjuI     [ (7/12)GAANNNNNNNTTGG(11/6) ]
31 #    multi extrasite cutter: TaqII    [ GACCGA(11/9),CACCCA(11/9) ]
33 # the test sequence *cut* (not site) map (recog sites in lc)
35 #+    AasI(circ)
36 #+         HindIII                     AasI                      
37 # 1   CTCGaagcttAGCAAACGGTTTCTACgacgttatcgtcATTCGGGgcaagcgTCGGCGAT  60
38 #-      IIIdniH                  IsaA      
41 #+                       BceSI                             AjuI 
42 #+                       AarI                          AasI
43 # 61  TCGGACGTGcacctgcAAATGCGCGGCgTTAgcgaggtgGCGAgacttttatgtcCCCCT 120
44 #-                        IraA                    IsaA            
45 #-                  ISecB                         IujA      
47 #+                                                         IIqaT         
48 #+                             AjuI                TaqII             
49 # 121 gaagcggttattggTTATATGGTGTTCGTgaccgaTCTAATCCATATTTATTTTTGGCAG 180
50 #-                    IujA                  IIqaT                 
51 #-                                                  TaqII          
53 #+                          
54 # 181 TGCtgggtgTTACgacTCGCGA 202 
55 #-              (cric)IsaA   
57 # so we have +/- cut sites (tpi's, not nt's), in positive strand 
58 # coordinates:
59 # HindIII : (5, 9)
60 # AasI    : (33, 31), (110,108)
61 # AasI    : (200,202=0) when circularized
62 # BceSI   : (79, 79)
63 # AarI    : (80, 84)
64 # AjuI    : (145, 140) / (113, 108)
65 # TaqII   : (166, 164) / (174, 172)
67 ok( my $rebase_io = Bio::Restriction::IO->new(
68      -file   => test_input_file('withrefm.906'),
69      -format => 'withrefm',
70     ), 'read withrefm file');
72 ok( my $rebase_cln = $rebase_io->read, 'parse withrefm file');
74 # examples
75 # ambiguous, nonamibiguous X intrasite, extrasite
76 ok( my $ninz = $rebase_cln->get_enzyme('HindIII'), 'HindIII: nonambiguous intrasite cutter');
77 ok( my $nexz = $rebase_cln->get_enzyme('AarI'), 'AarI: nonambiguous extrasite cutter');
78 ok( my $ainz = $rebase_cln->get_enzyme('AasI'), 'AasI: ambiguous intrasite cutter' );
79 ok( my $aexz = $rebase_cln->get_enzyme('BceSI'), 'BceSI: ambiguous extrasite cutter' );
80 # central recognition site: (s/t)[site](m/n)
81 ok( my $cenz = $rebase_cln->get_enzyme('AjuI'), 'AjuI: cutter with central recog site');
82 # multisite extrasite:
83 ok (my $menz = $rebase_cln->get_enzyme('TaqII'), 'TaqII: multi-extrasite cutter');
85 ok (my $examples = Bio::Restriction::EnzymeCollection->new(
86         -enzymes=>[$ninz,$ainz, $ainz, $aexz, $cenz, $menz]
87     ) );
90 # build pretend analysis object to test internals
92 my $an = {};
93 bless($an, 'Bio::Restriction::Analysis');
94 $an->seq($seq);
96 my ($plus_sites, $minus_sites);
97 # intrasite cutters
99 $plus_sites = $an->_make_cuts( $seq->seq, $ninz );
100 $minus_sites = $an->_make_cuts( $seq->seq, $ninz,'COMP' );
101 is_deeply( $plus_sites, [5], 'HindIII plus');
102 is_deeply( $minus_sites, [9], 'HindIII minus');
104 $plus_sites = $an->_make_cuts(  $seq->seq, $ainz );
105 $minus_sites = $an->_make_cuts( $seq->seq, $ainz,'COMP' );
106 is_deeply( $plus_sites, [33, 110], 'AasI plus');
107 is_deeply( $minus_sites, [31, 108], 'AasI  minus');
109 # extrasite cutters
111 $plus_sites = $an->_make_cuts( $seq->seq, $nexz );
112 $minus_sites = $an->_make_cuts( $seq->seq, $nexz, 'COMP');
113 is_deeply( $plus_sites, [80], 'AarI plus');
114 is_deeply( $minus_sites, [84], 'AarI  minus');
116 $plus_sites = $an->_make_cuts( $seq->seq, $aexz );
117 $minus_sites = $an->_make_cuts( $seq->seq, $aexz, 'COMP');
118 is_deeply( $plus_sites, [79], 'BceSI plus');
119 is_deeply( $minus_sites, [79], 'BceSI  minus');
121 # central site cutter
122 $plus_sites = $an->_make_cuts( $seq->seq, $cenz );
123 $minus_sites = $an->_make_cuts( $seq->seq, $cenz, 'COMP');
125 is_deeply( $plus_sites, [145, 113], 'AjuI plus');
126 is_deeply( $minus_sites, [140, 108], 'AjuI minus');
128 # multisite extrasite cutter
129 $plus_sites =  $an->_make_cuts( $seq->seq, $menz );
130 $minus_sites =  $an->_make_cuts( $seq->seq, $menz, 'COMP' );
132 is_deeply( $plus_sites, [166, 174], 'TaqII plus');
133 is_deeply( $minus_sites, [164, 172], 'TaqII minus');
135 # real Analysis object
136 # start restriction analysis
137 ok( my $analysis = Bio::Restriction::Analysis->new(
138      -seq     => $seq,
139      -enzymes => $rebase_cln
140     ), "build real B:R::Analysis object");
142 # retrieve fragment map
143 my @fm = $analysis->fragment_maps($examples);
144 is( @fm, 13, '13 fragments');
145 # circularize
146 ok( $seq->is_circular(1), 'circularize');
147 ok( $analysis->cut, 'recut');
148 @fm = $analysis->fragment_maps($examples);
149 is_deeply( [$analysis->positions('AasI')], [33, 110, 200], 'circ: AasI
150 site at origin' );
151 is( @fm, 13, 'circ: still 13 fragments (cut site at origin)');
154 # Emmanuel's tests / bug3015
156 use_ok('Bio::Restriction::IO');
157 use_ok('Bio::Restriction::Analysis');
159 #ATGAGCGCTcacgtcACTAG^TTCTAGAGcctcagcAATTC^CGATCccgctcGATTAATGC^TccgcAGCAGCGATATCGAG^CATGGTCATGAgaatgcGGC^ATCGATCGGCATTATATcacgtcAATCGCGTCGCTGCATGCTAGCG
160 $seq = new Bio::PrimarySeq(
161      -seq        => 'ATGAGCGCTcacgtcACTAGTTCTAGAGcctcagcAATTCCGATCccgctcGATTAATGCTccgcAGCAGCGATATCGAGCATGGTCATGAgaatgcGGCATCGATCGGCATTATATcacgtcAATCGCGTCGCTGCATGCTAGCG',
162      -primary_id => 'test1',
163      -molecule   => 'dna'
166 ok( $rebase_io = Bio::Restriction::IO->new(
167      -file   => test_input_file('withrefm.906'),
168      -format => 'withrefm',
169     ), 'read withrefm file');
171 ok( $rebase_cln = $rebase_io->read, 'parse withrefm file');
173 my @enzs = qw/AbeI AccBSI AciI Asp26HI BmgBI/;
175 # Get the enzymes with back cut site
176 # 'AbeI'    CCTCAGC(-5/-2) #1
177 # 'AccBSI'  CCGCTC(-3/-3)  #1
178 # 'AciI'    CCGC(-3/-1)    #2
179 # 'Asp26HI' GAATGC(1/-1)   #1
180 # 'BmgBI'   CACGTC(-3/-3)  #2
182 ok(my $collection = Bio::Restriction::EnzymeCollection->new(-empty => 1), "Collection initiated");
184 foreach my $e (@enzs){
186     ok(my $enz = $rebase_cln->get_enzyme($e), "$e: found ok into collection");
187     $collection->enzymes($enz);
190 $an = { };
191 bless($an, 'Bio::Restriction::Analysis');
192 $an->seq($seq);
193 $an->enzymes($collection);
195 #Test all types of stuff from the enzyme
196 my $data = {
197    'AbeI'    => { 'p' => [23],
198                   'm' => [26],
199                   'pos' => 2,
200                   'f' => 3,
201                   'o' => "5'",
202                   's' => 'CC^TCAGC',
203                   'r' => 'GCTGAGG',
204                   'c' => '-5',
205                   'rc' => '-2' },
207    'AccBSI'  => { 'p' => [42],
208                   'm' => [42],
209                   'pos' => 1,
210                   'f' => 2,
211                   'o' => "blunt",
212                   's' => 'CCG^CTC',
213                   'r' => 'GAGCGG',
214                   'c' => '-3',
215                   'rc' => '-3' },
217    'AciI'    => { 'p' => [42,58,100],
218                   'm' => [44,60,102],
219                   'pos' => 6,
220                   'f' => 7,
221                   'o' => "5'",
222                   's' => 'C^CGC',
223                   'r' => 'GCGG',
224                   'c' => '-3',
225                   'rc' => '-1' },
227    'Asp26HI' => { 'p' => [98],
228                   'm' => [90],
229                   'pos' => 1,
230                   'f' => 2,
231                   'o' => "3'",
232                   's' => 'GAATGC',
233                   'r' => 'GCATTC',
234                   'c' => 7,
235                   'rc' => '-1' },
237    'BmgBI'   => { 'p' => [6, 114],
238                   'm' => [6, 114],
239                   'pos' => 2,
240                   'f' => 3,
241                   'o' => "blunt",
242                   's' => 'CAC^GTC',
243                   'r' => 'GACGTG',
244                   'c' => '-3',
245                   'rc' => '-3' },
248 foreach my $e (@enzs){
250    my $d = $data->{$e};
251    my $z = $rebase_cln->get_enzyme($e);
252    my $minus_sites = $an->_make_cuts($seq->seq, $z, 'COMP');
253    my $plus_sites  = $an->_make_cuts($seq->seq, $z);
255    is_deeply($plus_sites,  $d->{p}, "$e plus");
256    is_deeply($minus_sites, $d->{m}, "$e minus");
258    ok(scalar($an->fragments($z)) eq $d->{f}, "$e fragment");
259    ok(scalar($an->positions($e)) eq $d->{pos}, "$e positions");
261    is($z->overhang(), $d->{'o'}, "$e Overhang");
262    is($z->name(), "$e", "$e name");
263    is($z->site(), $d->{s}, "$e site");
264    is($z->revcom_site(), $d->{r}, "$e revcom_site");
265    is($z->cut(), $d->{c}, "$e cut");
266    is($z->complementary_cut(), $d->{rc}, "$e complementary_cut");