286
304
$seq3 = Bio::Seq->new(-id => 3, -seq => 'ggttaaaa', -description => 'third', -is_circular => 1);
287
305
is(Bio::SeqUtils->revcom_with_features($seq3)->is_circular, 1, 'still circular');
308
# delete, insert and ligate
309
# prepare some sequence objects
310
my $seq_obj = Bio::Seq->new(
311
-seq =>'aaaaaaaaaaccccccccccggggggggggtttttttttt',
312
-display_id => 'seq1',
313
-desc => 'some sequence for testing'
315
my $subfeat1 = Bio::SeqFeature::Generic->new(
316
-primary_tag => 'sf1',
322
my $subfeat2 = Bio::SeqFeature::Generic->new(
323
-primary_tag => 'sf2',
328
my $subfeat3 = Bio::SeqFeature::Generic->new(
329
-primary_tag => 'sf3',
335
my $composite_feat1 = Bio::SeqFeature::Generic->new(
336
-primary_tag => 'comp_feat1',
341
my $coll_sf = Bio::Annotation::Collection->new;
342
$coll_sf->add_Annotation(
343
'comment', Bio::Annotation::Comment->new( '-text' => 'a comment on sf1')
345
$subfeat1->annotation($coll_sf);
347
$composite_feat1->add_SeqFeature( $subfeat1);
348
$composite_feat1->add_SeqFeature( $subfeat2);
349
$composite_feat1->add_SeqFeature( $subfeat3);
350
my $feature1 = Bio::SeqFeature::Generic->new(
351
-primary_tag => 'feat1',
356
my $feature2 = Bio::SeqFeature::Generic->new(
357
-primary_tag => 'feat2',
363
my $feature3 = Bio::SeqFeature::Generic->new(
364
-primary_tag => 'feat3',
369
my $feature4 = Bio::SeqFeature::Generic->new(
370
-primary_tag => 'feat4',
375
my $feature5 = Bio::SeqFeature::Generic->new(
376
-primary_tag => 'feat5',
382
my $feature6 = Bio::SeqFeature::Generic->new(
383
-primary_tag => 'feat6',
388
$seq_obj->add_SeqFeature( $composite_feat1, $feature1, $feature2, $feature3, $feature4, $feature5, $feature6);
390
my $coll = Bio::Annotation::Collection->new;
391
$coll->add_Annotation(
392
'comment', Bio::Annotation::Comment->new( '-text' => 'a comment on the whole sequence')
394
$seq_obj->annotation($coll);
397
my $fragment_obj = Bio::Seq->new(
399
-display_id => 'fragment1',
400
-desc => 'some fragment to insert'
402
my $frag_feature1 = Bio::SeqFeature::Generic->new(
403
-primary_tag => 'frag_feat1',
404
-seq_id => 'fragment1',
409
$fragment_obj->add_SeqFeature( $frag_feature1 );
410
my $frag_coll = Bio::Annotation::Collection->new;
411
$frag_coll->add_Annotation(
412
'comment', Bio::Annotation::Comment->new( '-text' => 'a comment on the fragment')
414
$fragment_obj->annotation($frag_coll);
420
$product = Bio::SeqUtils->delete( $seq_obj, 11, 20 );
422
"No error thrown when deleting a segment of the sequence"
425
my ($seq_obj_comment) = $seq_obj->annotation->get_Annotations('comment');
426
my ($product_comment) = $product->annotation->get_Annotations('comment');
427
is( $seq_obj_comment, $product_comment, 'annotation of whole sequence has been moved to new molecule');
430
grep ($_ eq 'deletion of 10bp',
431
map ($_->get_tag_values('note'),
432
grep ($_->primary_tag eq 'misc_feature', $product->get_SeqFeatures)
435
"the product has an additional 'misc_feature' and the note specifies the lengths of the deletion'"
438
my ($composite_feat1_del) = grep ($_->primary_tag eq 'comp_feat1', $product->get_SeqFeatures);
439
ok ($composite_feat1_del, "The composite feature is still present");
440
isa_ok( $composite_feat1_del, 'Bio::SeqFeature::Generic');
441
isa_ok( $composite_feat1_del->location, 'Bio::Location::Split', "a composite feature that spanned the deletion site has been split up, Location");
443
is( $composite_feat1_del->get_SeqFeatures, 2, 'one of the sub-eatures of the composite feature has been deleted completely');
444
my ($subfeat1_del) = grep ($_->primary_tag eq 'sf1', $composite_feat1_del->get_SeqFeatures);
445
ok ($subfeat1_del, "sub-feature 1 of the composite feature is still present");
446
is ($subfeat1->end, 12, "the original end of sf1 is 12");
447
is ($subfeat1_del->end, 10, "after deletion, the end of sf1 is 1nt before the deletion site");
448
is ($subfeat1->location->end_pos_type, 'EXACT', 'the original end location of sf1 EXACT');
450
my ($subfeat1_comment) = $subfeat1->annotation->get_Annotations('comment');
451
my ($subfeat1_del_comment) = $subfeat1_del->annotation->get_Annotations('comment');
452
is( $subfeat1_comment, $subfeat1_del_comment, 'annotation of subeature 1 has been moved to new molecule');
454
my ($feature1_del) = grep ($_->primary_tag eq 'feat1', $product->get_SeqFeatures);
455
ok ($feature1_del, "feature1 is till present");
456
isa_ok( $feature1_del->location, 'Bio::Location::Split', 'feature1 location has now been split by the deletion and location object');
457
is( my @feature1_del_sublocs = $feature1_del->location->each_Location, 2, 'feature1 has two locations after the deletion');
458
is( $feature1_del_sublocs[0]->start, 2, 'feature1 start is unaffected by the deletion');
459
is( $feature1_del_sublocs[0]->end, 10, 'feature1 end of first split is 1nt before deletion site');
460
is( $feature1_del_sublocs[1]->start, 11, 'feature1 start of second split is 1nt after deletion site');
461
is( $feature1_del_sublocs[1]->end, 15, 'feature1 end of second split has been adjusted correctly');
462
my @fd1_notes = $feature1_del->get_tag_values('note');
463
is( @fd1_notes,1, 'split feature now has a note');
464
is (shift @fd1_notes, '10bp internal deletion between pos 10 and 11', 'got the expected note about length and position of deletion');
466
my ($feature3_del) = grep ($_->primary_tag eq 'feat3', $product->get_SeqFeatures);
467
ok ($feature3_del, "feature3 is till present");
468
is_deeply ( [$feature3_del->start, $feature3_del->end], [$feature3->start - 10, $feature3->end - 10], 'a feature downstream of the deletion site is shifted entirely by 10nt to the left');
470
my ($feature4_del) = grep ($_->primary_tag eq 'feat4', $product->get_SeqFeatures);
471
ok ($feature4_del, "feature4 is till present");
472
is_deeply ( [$feature4_del->start, $feature4_del->end], [$feature4->start, $feature4->end], 'a feature upstream of the deletion site is not repositioned by the deletion');
474
my ($feature2_del) = grep ($_->primary_tag eq 'feat2', $product->get_SeqFeatures);
475
ok ($feature2_del, "feature2 is till present");
476
is ( $feature2_del->start, 11, 'start pos of a feature that started in the deletion site has been altered accordingly');
477
my @fd2_notes = $feature2_del->get_tag_values('note');
478
is( @fd2_notes,1, 'feature 2 now has a note');
479
is (shift @fd2_notes, "6bp deleted from feature 3' end", "note added to feature2 about deletion at 3' end");
481
ok (!grep ($_->primary_tag eq 'feat5', $product->get_SeqFeatures), 'a feature that was completely positioned inside the deletion site is not present on the new molecule');
483
my ($feature6_del) = grep ($_->primary_tag eq 'feat6', $product->get_SeqFeatures);
484
ok ($feature6_del, "feature6 is till present");
485
is ( $feature6_del->start, 11, 'start pos of a feature that started in the deletion site has been altered accordingly');
486
is ( $feature6_del->end, 15, 'end pos of a feature that started in the deletion site has been altered accordingly');
492
$product = Bio::SeqUtils->insert( $seq_obj, $fragment_obj, 10 );
494
"No error thrown when inserting a fragment into recipient sequence"
496
($seq_obj_comment) = $seq_obj->annotation->get_Annotations('comment');
497
($product_comment) = $product->annotation->get_Annotations('comment');
498
is( $seq_obj_comment, $product_comment, 'annotation of whole sequence has been moved to new molecule');
500
my ($composite_feat1_ins) = grep ($_->primary_tag eq 'comp_feat1', $product->get_SeqFeatures);
501
ok ($composite_feat1_ins, "The composite feature is still present");
502
isa_ok( $composite_feat1_ins, 'Bio::SeqFeature::Generic');
503
isa_ok( $composite_feat1_ins->location, 'Bio::Location::Split', "a composite feature that spanned the insertion site has been split up, Location");
504
is( $composite_feat1_ins->get_SeqFeatures, 3, 'all of the parts of the composite feature are still present');
506
my ($subfeat1_ins) = grep ($_->primary_tag eq 'sf1', $composite_feat1_ins->get_SeqFeatures);
507
ok ($subfeat1_ins, "sub-feature 1 of the composite feature is still present");
508
is ($subfeat1->end, 12, "the original end of sf1 is 12");
509
is ($subfeat1_ins->end, $subfeat1->end + $fragment_obj->length, "after insertion, the end of sf1 has been shifted by the length of the insertion");
510
isa_ok( $subfeat1_ins->location, 'Bio::Location::Split', 'sub-feature 1 (spans insertion site) is now split up and');
512
[$subfeat1->location->end_pos_type, $subfeat1->location->start_pos_type],
513
[$subfeat1_ins->location->end_pos_type, $subfeat1_ins->location->start_pos_type],
514
'the start and end position types of sub-feature1 have not changed'
516
($subfeat1_comment) = $subfeat1->annotation->get_Annotations('comment');
517
my ($subfeat1_ins_comment) = $subfeat1_ins->annotation->get_Annotations('comment');
518
is( $subfeat1_comment, $subfeat1_ins_comment, 'annotation of subeature 1 has been moved to new molecule');
519
my @sf1ins_notes = $subfeat1_ins->get_tag_values('note');
520
is( @sf1ins_notes,1, 'split feature now has a note');
521
is (shift @sf1ins_notes, '10bp internal insertion between pos 10 and 21', 'got the expected note about length and position of insertion');
523
my ($feature3_ins) = grep ($_->primary_tag eq 'feat3', $product->get_SeqFeatures);
524
ok ($feature3_ins, "feature3 is till present");
526
[$feature3_ins->start, $feature3_ins->end],
527
[$feature3->start + $fragment_obj->length, $feature3->end + $fragment_obj->length],
528
'a feature downstream of the insertion site is shifted entirely to the left by the length of the insertion');
530
my ($feature4_ins) = grep ($_->primary_tag eq 'feat4', $product->get_SeqFeatures);
531
ok ($feature4_ins, "feature4 is till present");
532
is_deeply ( [$feature4_ins->start, $feature4_ins->end], [$feature4->start, $feature4->end], 'a feature upstream of the insertion site is not repositioned');
534
my ($frag_feature1_ins) = grep ($_->primary_tag eq 'frag_feat1', $product->get_SeqFeatures);
535
ok( $frag_feature1_ins, 'a feature on the inserted fragment is present on the product molecule');
537
[$frag_feature1_ins->start, $frag_feature1_ins->end],
539
'position of the feature on the insert has been adjusted to product coordinates'
541
is( $frag_feature1_ins->strand, $frag_feature1->strand, 'strand of the feature on insert has not changed');
542
like( $product->desc, qr/some fragment to insert/, 'desctription of the product contains description of the fragment');
543
like( $product->desc, qr/some sequence for testing/, 'desctription of the product contains description of the recipient');
546
grep ($_ eq 'inserted fragment',
547
map ($_->get_tag_values('note'),
548
grep ($_->primary_tag eq 'misc_feature', $product->get_SeqFeatures)
551
"the product has an additional 'misc_feature' with note='inserted fragment'"
557
$product = Bio::SeqUtils->ligate(
558
-recipient => $seq_obj,
559
-fragment => $fragment_obj,
565
"No error thrown using 'ligate' of fragment into recipient"
568
is ($product->length, 30, 'product has the expected length');
569
is ($product->subseq(11,20), 'atatatatat', 'the sequence of the fragment is inserted into the product');
571
my ($inserted_fragment_feature) = grep(
572
grep($_ eq 'inserted fragment', $_->get_tag_values('note')),
573
grep( $_->has_tag('note'), $product->get_SeqFeatures)
576
ok($inserted_fragment_feature, 'we have a feature annotating the ligated fragment');
578
[$inserted_fragment_feature->start, $inserted_fragment_feature->end],
580
'coordinates of the feature annotating the ligated feature are correct'
583
my ($fragment_feat_lig) = grep ($_->primary_tag eq 'frag_feat1', $product->get_SeqFeatures);
584
ok( $fragment_feat_lig, 'the fragment feature1 is now a feature of the product');
585
is_deeply( [$fragment_feat_lig->start, $fragment_feat_lig->end], [17,19], 'start and end of a feature on the fragment are correct after insertion with "flip" option');
589
skip("Storable::dclone not supported yet for Bio::SeqUtils, see ", 9) if $Bio::Root::Root::CLONE_CLASS eq 'Storable';
591
# test clone_obj option (create new objects via clone not 'new')
592
my $foo_seq_obj = Bio::Seq::Foo->new(
593
-seq =>'aaaaaaaaaaccccccccccggggggggggtttttttttt',
594
-display_id => 'seq1',
595
-desc => 'some sequence for testing'
597
for ($composite_feat1, $feature1, $feature2, $feature3, $feature4, $feature5) {
598
$foo_seq_obj->add_SeqFeature( $_ );
600
$foo_seq_obj->annotation($coll);
604
$product = Bio::SeqUtils->delete( $foo_seq_obj, 11, 20, { clone_obj => 0} );
606
"Trying to delete from an object of a custom Bio::Seq subclass that doesn't allow calling 'new' throws an error"
611
$product = Bio::SeqUtils->delete( $foo_seq_obj, 11, 20, { clone_obj => 1} );
613
"Deleting from Bio::Seq::Foo does not throw an error when using the 'clone_obj' option to clone instead of calling 'new'"
616
isa_ok( $product, 'Bio::Seq::Foo');
618
# just repeat some of the tests for the cloned feature
620
grep ($_ eq 'deletion of 10bp',
621
map ($_->get_tag_values('note'),
622
grep ($_->primary_tag eq 'misc_feature', $product->get_SeqFeatures)
625
"the product has an additional 'misc_feature' and the note specifies the lengths of the deletion'"
627
($composite_feat1_del) = grep ($_->primary_tag eq 'comp_feat1', $product->get_SeqFeatures);
628
ok ($composite_feat1_del, "The composite feature is still present");
629
isa_ok( $composite_feat1_del, 'Bio::SeqFeature::Generic');
630
isa_ok( $composite_feat1_del->location, 'Bio::Location::Split', "a composite feature that spanned the deletion site has been split up, Location");
632
# ligate with clone_obj
635
$product = Bio::SeqUtils->ligate(
636
-recipient => $foo_seq_obj,
637
-fragment => $fragment_obj,
643
"'ligate' without clone_obj option dies with a Bio::Seq::Foo object that can't call new"
648
$product = Bio::SeqUtils->ligate(
649
-recipient => $foo_seq_obj,
650
-fragment => $fragment_obj,
657
"'ligate' with clone_obj option works with a Bio::Seq::Foo object that can't call new"
added
removed
t/SeqTools/SeqUtils.t
