t/Restriction/Analysis.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4
   5 use strict;
   6
   7 BEGIN {
   8     use lib '.';
   9     use Bio::Root::Test;
  10
  11     test_begin(-tests => 182);
  12
  13     use_ok('Bio::Restriction::Enzyme');
  14     use_ok('Bio::Restriction::Enzyme::MultiCut');
  15     use_ok('Bio::Restriction::Enzyme::MultiSite');
  16     use_ok('Bio::Restriction::EnzymeCollection');
  17     use_ok('Bio::Restriction::Analysis');
  18     use_ok('Bio::SeqIO');
  19 }
  20
  21 #
  22 # Bio::Restriction::Enzyme
  23 #
  24
  25 my ($re, $seq, $iso, %meth, $microbe, $source, @vendors, @refs, $name);
  26 ok $re=Bio::Restriction::Enzyme->new(-enzyme=>'EcoRI', -site=>'G^AATTC');
  27 isa_ok($re, 'Bio::Restriction::EnzymeI');
  28 is $re->cut, 1;
  29 ok ! $re->cut(0);
  30 is $re->complementary_cut, 6;
  31 ok $re->cut(1);
  32
  33 is $re->complementary_cut,5;
  34 is $re->site,'G^AATTC';
  35 ok $seq = $re->seq;
  36 isa_ok($seq, 'Bio::PrimarySeqI');
  37 is $seq->seq, 'GAATTC';
  38 is $re->string,'GAATTC';
  39 is $re->revcom, 'GAATTC';
  40 is $re->recognition_length, 6;
  41 is $re->cutter, 6;
  42 is $re->palindromic, 1;
  43 is $re->overhang, "5'";
  44 is $re->overhang_seq, 'AATT';
  45 is $re->is_ambiguous, 0;
  46
  47 ok $re->compatible_ends($re);
  48
  49 ok $re->isoschizomers('BamHI', 'AvaI'); # not really true :)
  50
  51 is my @isos=$re->isoschizomers, 2;
  52 is $isos[0],'BamHI';
  53 ok $re->purge_isoschizomers;
  54 is scalar($re->isoschizomers), 0;
  55 ok $re->methylation_sites(2,5); # not really true :)
  56 ok %meth = $re->methylation_sites;
  57 is $meth{2}, 5;
  58 ok $re->purge_methylation_sites;
  59 is scalar($re->methylation_sites), 0;
  60
  61
  62 ok $re->microbe('E. coli');
  63 ok $microbe = $re->microbe;
  64 is $microbe, "E. coli";
  65 ok $re->source("Rob"); # not really true :)
  66
  67 ok $source = $re->source;
  68 is $source, "Rob";
  69
  70 ok !$re->vendor;
  71 ok $re->vendors('NEB'); # my favorite
  72 ok @vendors = $re->vendors;
  73 is $vendors[0], "NEB";
  74 $re->purge_vendors;
  75 is scalar($re->vendors), 0;
  76
  77 ok $re->references('Rob et al');
  78 ok @refs = $re->references;
  79 is $refs[0], "Rob et al";
  80 $re->purge_references;
  81 is scalar($re->references), 0;
  82
  83 ok $re->name('BamHI');
  84 ok $name = $re->name;
  85 is $name, "BamHI";
  86
  87 $re->verbose(2);
  88
  89 eval {$re->is_prototype};
  90 ok($@);
  91 like($@, qr/Can't unequivocally assign prototype based on input format alone/, 'bug 2179');
  92 $re->verbose(2);
  93
  94 is $re->is_prototype(0), 0;
  95 is $re->is_prototype, 0;
  96 is $re->is_prototype(1), 1;
  97 is $re->is_prototype, 1;
  98
  99 is $re->prototype_name, $re->name;
 100 ok ! $re->is_prototype(0);
 101 is $re->prototype_name('XxxI'), 'XxxI';
 102 is $re->prototype_name, 'XxxI';
 103
 104
 105 is $re->cutter, 6;
 106 ok $re->seq->seq('RCATGY');
 107 is $re->cutter, 5;
 108
 109 ok my $re2 = $re->clone;
 110 isnt $re, $re2;
 111 is $re->name, $re2->name;
 112
 113 ok $re = Bio::Restriction::Enzyme->new(-enzyme=>'AciI',
 114                                                                                 -site=>'C^CGC');
 115 is $re->palindromic, 0;
 116 is $re->is_palindromic, 0;
 117
 118 #
 119 # Bio::Restriction::Enzyme::MultiSite
 120 #
 121
 122 ok $re=Bio::Restriction::Enzyme::MultiSite->new(-enzyme=>'TaqII',
 123                                               -site=>'GACCGA',
 124                                               -cut=>17,
 125                                               -complementary_cut=>15
 126                                              );
 127 ok $re2=Bio::Restriction::Enzyme::MultiSite->new(-enzyme=>'TaqII',
 128                                                 -site=>'CACCCA',
 129                                                 -cut=>17,
 130                                                 -complementary_cut=>15
 131                                                );
 132 isa_ok( $re, 'Bio::Restriction::EnzymeI');
 133 isa_ok( $re2, 'Bio::Restriction::EnzymeI');
 134 ok $re->others($re2);
 135 ok $re2->others($re);
 136
 137 is $re->others, 1;
 138 is $re2->others, 1;
 139
 140 ok my $re3 = $re->clone;
 141 isnt $re, $re3;
 142 is $re->name , $re3->name; # wouldn't this be a circular reference???
 143 #print Dumper $re, $re3;exit;
 144
 145 #
 146 # Bio::Restriction::Enzyme::MultiCut
 147 #
 148 #Hin4I has four cut sites [(8/13)GAYNNNNNVTC(13/8)],
 149
 150 ok $re = Bio::Restriction::Enzyme::MultiCut->new(-enzyme=>'Hin4I',
 151                                               -site=>'GAYNNNNNVTC',
 152                                               -cut=>-8,
 153                                               -complementary_cut=>-13
 154                                              );
 155 ok $re2 = Bio::Restriction::Enzyme::MultiCut->new(-enzyme=>'Hin4I',
 156                                                -site=>'GAYNNNNNVTC',
 157                                                -cut=>13,
 158                                                -complementary_cut=>8
 159                                               );
 160 isa_ok($re, 'Bio::Restriction::EnzymeI');
 161 isa_ok($re2, 'Bio::Restriction::EnzymeI');
 162 ok $re->others($re2);
 163 ok $re2->others($re);
 164
 165 ok $re3 = $re->clone;
 166 isnt $re, $re3;
 167 is $re->name, $re3->name;
 168 #print Dumper $re, $re3;exit;
 169
 170 #
 171 # Bio::Restriction::EnzymeCollection
 172 #
 173
 174 my ($collection, $enz, $new_set);
 175
 176 ok $collection = Bio::Restriction::EnzymeCollection->new(-empty=>1);
 177 is $collection->each_enzyme, 0;
 178 # default set
 179 $collection = Bio::Restriction::EnzymeCollection->new;
 180 is $collection->each_enzyme, 532;
 181 is $collection->each_enzyme, 532;
 182
 183 ok $enz = $collection->get_enzyme('AclI');
 184 isa_ok($enz, 'Bio::Restriction::Enzyme');
 185 is my @enzymes=$collection->available_list, 532;
 186
 187 ok $new_set = $collection->blunt_enzymes;
 188 isa_ok($enz, 'Bio::Restriction::Enzyme');
 189 is $new_set->each_enzyme, 114;
 190
 191 #map {print $_->name, ": ", $_->cutter, "\n"; } $collection->each_enzyme;
 192
 193 ok $new_set = $collection->cutters(8);
 194 is $new_set->each_enzyme, 17;
 195
 196 ok $new_set=$collection->cutters(-start => 8, -end => 8);
 197 is $new_set->each_enzyme, 17;
 198
 199 ok $new_set=$collection->cutters(-start => 6, -end => 8);
 200 is $new_set->each_enzyme, 293;
 201
 202 ok $new_set=$collection->cutters(-start => 6, -end => 8,  -exclusive => 1);
 203 is $new_set->each_enzyme, 10;
 204
 205 ok $new_set = $collection->cutters([4,8]);
 206 is $new_set->each_enzyme, 129;
 207
 208 # bug 2128; enhancement request to pass array ref of sizes
 209
 210 #
 211 # Restriction::Analysis
 212 #
 213
 214
 215 ok my $seqio=Bio::SeqIO->new(-file=>test_input_file('dna1.fa'),
 216                          -format=>'fasta');
 217 ok $seq=$seqio->next_seq;
 218
 219 ok my $ra = Bio::Restriction::Analysis->new(-seq=>$seq);
 220 ok my $uniq = $ra->unique_cutters;
 221
 222 # test most objects
 223 is $ra->unique_cutters->each_enzyme, 42, 'number of unique cutters';
 224 is $ra->fragments('RsaI'), 2, 'number of RsaI fragments';
 225 is $ra->max_cuts, 9, 'number of maximum cutters';
 226 is $ra->zero_cutters->each_enzyme, 477, 'number of zero cutters';
 227 is $ra->cutters->each_enzyme, 55, 'number of cutters';
 228 is $ra->cutters(3)->each_enzyme, 8, 'number of 3x cutters';
 229 is $ra->fragments('MseI'), 4, '4 MseI fragments';
 230 is $ra->cuts_by_enzyme('MseI'), 3, '3 MseI cut sites';
 231
 232 #my $z = $ra->cutters(3);
 233 #my $out=Bio::Restriction::IO->new;
 234 #$out->write($z);
 235
 236
 237 is $ra->fragments('PspEI'), 2, 'expected 2 PspEI fragments';
 238 is $ra->cuts_by_enzyme('PspEI'), 1;
 239 is $ra->cuts_by_enzyme('XxxI'), undef;
 240
 241
 242 is my @ss = $ra->sizes('PspEI'), 2, 'expected 2 sizes for PspEI';
 243 is $ss[0] + $ss[1], $seq->length;
 244
 245 # Issue 3157
 246 $re = Bio::Restriction::Enzyme->new(-enzyme=>'PspEI', -site=>'G^GTNACC');
 247 is @ss = $ra->sizes($re), 2, 'expected 2 sizes for PspEI';
 248 is $ss[0] + $ss[1], $seq->length;
 249
 250 is $ra->fragments('MwoI'), 1, 'not circular expected 1 fragments for MwoI as it doesnt cut';
 251
 252 # circularise the sequence, regenerate the cuts and test again
 253 # note that there is one less fragment now!
 254 ok $seq->is_circular(1);
 255
 256 # we need to regenerate all the cuts
 257 ok $ra->cut;
 258
 259 is $ra->fragments('RsaI'), 1, 'number of RsaI fragments';
 260 is $ra->fragments('MseI'), 3, '3 circular MseI fragments';
 261 is $ra->cuts_by_enzyme('MseI'), 3, '3 circular MseI cut sites';
 262 is $ra->fragments('AciI'), 1, 'number for AciI a non-palindromic enzyme';
 263
 264 is $ra->fragments('MwoI'), 1, '1 fragment for MwoI as it cuts across the circ point';
 265
 266 ok my @rb=($collection->get_enzyme("AluI"), $collection->get_enzyme("MseI"), $collection->get_enzyme("MaeIII"));
 267
 268 # test multiple digests
 269 ok my $rbc=Bio::Restriction::EnzymeCollection->new(-empty=>1);
 270 ok $rbc->enzymes(@rb);
 271 ok $ra->cut('multiple', $rbc);
 272 is $ra->fragments('multiple_digest'),7, '7 fragments in the multiple digest';
 273 is my @pos=$ra->positions('multiple_digest'),7, '7 positions in the multiple digest';
 274 is my @ssm = $ra->sizes('multiple_digest'),7, '7 sizes in the multiple digest';
 275 my $check_len;
 276 map {$check_len+=$_}@ssm;
 277 is $check_len, $seq->length;
 278
 279 # now test the non-palindromic part
 280 # HindI is a non palindromic enzyme that cuts 9 times
 281 is $ra->positions('HindI'), 9, ' expected 9 cuts for HindI';
 282
 283 # now we need to test the fragment maps
 284 # lets do this for HindI
 285 is my @fm=$ra->fragment_maps('HindI'), 9, 'expect 9 fragment maps for HindI';
 286 foreach my $fm (@fm) {
 287  is exists $fm->{'seq'}, 1, "sequence for ".$fm->{'seq'};
 288  is exists $fm->{'start'}, 1, "start at ".$fm->{'start'};
 289  is exists $fm->{'end'}, 1, "end at ".$fm->{'end'};
 290 }
 291
 292 # bug 2139
 293
 294 eval {$re = Bio::Restriction::Enzyme->new(
 295         -name    => 'Invalid',
 296         -site    => 'G^AATTE' );};
 297
 298 ok $@;
 299 like($@, qr(Unrecognized characters in site), 'bug 2139');
 300
 301 # 0-pos bug (Elia Stupka)
 302
 303 $seq = Bio::Seq->new(
 304     -display_name   => 'foo',
 305     -alphabet       => 'dna',
 306     -seq            => 'GATCNNNNGATC'
 307 );
 308
 309 $ra = Bio::Restriction::Analysis->new(-seq=>$seq);
 310
 311 is $ra->fragments('HindIII'), 1, 'number of HindIII fragments';
 312 is $ra->fragments('BfuCI'), 2, 'number of EcoRI fragments';
 313
 314 # passing a bad enzyme name
 315
 316 is $ra->fragments('FooBarI'), 1, 'number of RsaI fragments';
 317
 318