t/LocatableSeq.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib 't/lib';
   8     use BioperlTest;
   9
  10     test_begin(-tests => 82);
  11
  12         use_ok('Bio::LocatableSeq');
  13         use_ok('Bio::AlignIO');
  14 }
  15
  16 my ($str, $aln, $seq, $loc);
  17
  18 ok $seq = Bio::LocatableSeq->new(
  19                              -seq => '--atg---gta--',
  20                              -strand => 1,
  21                              -alphabet => 'dna'
  22                              );
  23 is $seq->alphabet, 'dna';
  24 is $seq->start, 1;
  25 is $seq->end, 6;
  26 is $seq->strand, 1;
  27 is $seq->no_gaps, 1;
  28 is $seq->column_from_residue_number(4), 9;
  29
  30 ok $loc = $seq->location_from_column(4);
  31 isa_ok $loc,'Bio::Location::Simple';
  32 is $loc->to_FTstring, 2;
  33
  34 ok $loc = $seq->location_from_column(6);
  35 isa_ok $loc,'Bio::Location::Simple';
  36 is $loc->start, 3;
  37 is $loc->location_type, 'IN-BETWEEN';
  38 is $loc->to_FTstring, '3^4';
  39
  40
  41 is $loc = $seq->location_from_column(2), undef;
  42
  43
  44 $str = Bio::AlignIO->new(-file=> test_input_file('testaln.pfam'));
  45 ok defined($str);
  46 isa_ok $str,'Bio::AlignIO';
  47 $aln = $str->next_aln();
  48 ok $seq = $aln->get_seq_by_pos(1);
  49 is ref($seq), 'Bio::LocatableSeq';
  50
  51 is $seq->get_nse, '1433_LYCES/9-246';
  52 is $seq->id, '1433_LYCES';
  53
  54 # test revcom and trunc
  55
  56 $seq = Bio::LocatableSeq->new(
  57                              -seq => '--atg---gta--',
  58                              -strand => 1,
  59                              -alphabet => 'dna'
  60                              );
  61
  62 my $seq2 = $seq->trunc(1,9);
  63 is $seq2->seq, '--atg---g';
  64 is $seq2->start, 1;
  65 is $seq2->end, 4;
  66 is $seq2->strand, $seq->strand;
  67
  68 $seq2 = $seq->trunc(3,8);
  69 is $seq2->seq, 'atg---';
  70 is $seq2->start, 1;
  71 is $seq2->end, 3;
  72
  73 is $seq->strand(-1), -1;
  74 is $seq->start, 1;
  75 is $seq->end, 6;
  76 $seq2 = $seq->trunc(3,8);
  77 is $seq2->seq, 'atg---';
  78 is $seq2->start, 4;
  79 is $seq2->end, 6;
  80 #use Data::Dumper;
  81 #print Dumper $seq;
  82 #print Dumper $seq2;
  83 #exit;
  84 $seq2 = $seq->revcom();
  85 is $seq2->seq, '--tac---cat--';
  86 is $seq2->start, $seq->start;
  87 is $seq2->end, $seq->end;
  88 is $seq2->strand, $seq->strand * -1;
  89
  90 # test column-mapping for -1 strand sequence
  91 $seq = Bio::LocatableSeq->new(
  92                              -seq => '--atg---gtaa-',
  93                              -strand => -1,
  94                              -alphabet => 'dna'
  95                              );
  96 is $seq->column_from_residue_number(5),5;
  97 is $seq->column_from_residue_number(4),9;
  98 ok $loc = $seq->location_from_column(4);
  99 isa_ok $loc,'Bio::Location::Simple';
 100 is $loc->to_FTstring, 6;
 101 ok $loc = $seq->location_from_column(6);
 102 isa_ok $loc,'Bio::Location::Simple';
 103 is $loc->start, 4;
 104 is $loc->location_type, 'IN-BETWEEN';
 105 is $loc->to_FTstring, '4^5';
 106
 107
 108 # more tests for trunc() with strand -1
 109
 110
 111 ok $seq = Bio::LocatableSeq->new(
 112                              -seq => '--atg---gta--',
 113                              -strand => -1,
 114                              -alphabet => 'dna'
 115                              );
 116 is $seq->alphabet, 'dna';
 117 is $seq->start, 1;
 118 is $seq->end, 6;
 119 is $seq->strand, -1;
 120 is $seq->no_gaps, 1;
 121 is $seq->column_from_residue_number(4), 5;
 122
 123
 124 ok $seq2 = $seq->trunc(1,9);
 125 is $seq2->seq, '--atg---g';
 126 is $seq2->start, 3;
 127 is $seq2->end, 6;
 128 is $seq2->strand, $seq->strand;
 129
 130 is $seq->location_from_column(3)->start, 6;
 131 is $seq->location_from_column(11)->start, 1;
 132 is $seq->location_from_column(9)->start, 3;
 133
 134
 135
 136 ok $seq2 = $seq->trunc(7,12);
 137 is $seq2->seq, '--gta-';
 138 is $seq2->start, 1;
 139 is $seq2->end, 3;
 140
 141
 142 ok $seq2 = $seq->trunc(2,6);
 143 is $seq2->seq, '-atg-';
 144 is $seq2->start, 4;
 145 is $seq2->end, 6;
 146
 147 ok $seq2 = $seq->trunc(4,7);
 148 is $seq2->seq, 'tg--';
 149 is $seq2->start, 4;
 150 is $seq2->end, 5;
 151
 152 ok $seq = Bio::LocatableSeq->new();
 153 is $seq->seq, undef;
 154 is $seq->start, undef;
 155 is $seq->end, undef;