t/Seq/MetaSeq.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib '.';
   8     use Bio::Root::Test;
   9
  10     test_begin(-tests => 132);
  11
  12         use_ok('Bio::Seq::Meta');
  13         use_ok('Bio::Seq::Meta::Array');
  14         use_ok('Bio::SeqIO');
  15         use_ok('Bio::AlignIO');
  16         use_ok('Bio::Seq::Quality');
  17 }
  18
  19 my $DEBUG = test_debug();
  20
  21 ok my $seq = Bio::Seq::Meta->new( -seq => "AT-CGATCGA");
  22 is $seq->is_flush, 1;
  23 is $seq->revcom->seq, 'TCGATCG-AT';
  24 is $seq->meta, "";
  25 ok $seq->force_flush(1);
  26 is $seq->meta, "          ";
  27 $seq->seq("AT-CGATCGATT");
  28 is $seq->meta, "            ";
  29 ok not $seq->force_flush(0);
  30
  31 ok $seq = Bio::Seq::Meta::Array->new( -seq => "AT-CGATCGA");
  32 is $seq->is_flush, 1;
  33 is $seq->revcom->seq, 'TCGATCG-AT';
  34 is $seq->meta_text, "";
  35 ok $seq->force_flush(1);
  36 $seq->seq("AT-CGATCGATT");
  37 is $seq->meta_text, "0 0 0 0 0 0 0 0 0 0 0 0";
  38 ok not $seq->force_flush(0);
  39
  40 ok $seq = Bio::Seq::Quality->new( -seq => "AT-CGATCGA");
  41 is $seq->meta_text, "";
  42 ok $seq->force_flush(1);
  43 is $seq->meta_text, "0 0 0 0 0 0 0 0 0 0";
  44 $seq->seq("AT-CGATCGATT");
  45 is $seq->meta_text, "0 0 0 0 0 0 0 0 0 0 0 0";
  46 ok not $seq->force_flush(0);
  47
  48 ok $seq = Bio::Seq::Meta->new
  49     ( -seq => "",
  50       -meta => "",
  51       -alphabet => 'dna',
  52       -id => 'myid'
  53     );
  54
  55 # create a sequence object
  56 ok $seq = Bio::Seq::Meta->new( -seq => "AT-CGATCGA",
  57                                -id => 'test',
  58                                -verbose => 2,
  59                                -force_flush => 1
  60                              );
  61
  62 is $seq->meta, "          ";
  63 is $seq->meta_length, 10;
  64
  65 # Create some random meta values, but gap in the wrong place
  66 my $metastring = "a-abb  bb ";
  67 $seq->meta($metastring);
  68 $seq->verbose(1);
  69
  70 # create some random meta values, but not for the last residue
  71 $metastring = "aa-bb  bb";
  72 ok $seq->meta($metastring), $metastring. " ";
  73
  74 # truncate the sequence by assignment
  75 $seq->force_flush(1);
  76 $seq->seq('AT-CGA');
  77 $seq->alphabet('dna');
  78 is $seq->meta, 'aa-bb ';
  79 is $seq->start, 1;
  80 is $seq->end, 5;
  81 $seq->force_flush(0);
  82
  83 # truncate the sequence with trunc()
  84 is $seq->strand(-1), -1;
  85 ok $seq = $seq->trunc(1,5);
  86 is $seq->start, 2;
  87 is $seq->end, 5;
  88 is $seq->seq, 'AT-CG';
  89 is $seq->meta, 'aa-bb';
  90 is $seq->strand, -1;
  91
  92 # revcom
  93 ok $seq = $seq->revcom;
  94 is $seq->seq, 'CG-AT';
  95 is $seq->meta, 'bb-aa';
  96 is $seq->strand, 1;
  97
  98 # submeta
  99 is $seq->subseq(2,4), 'G-A';
 100 is $seq->submeta(2,4), 'b-a';
 101 is $seq->submeta(2,undef, 'c-c'), 'c-ca';
 102 is $seq->submeta(2,4), 'c-c';
 103 is $seq->meta, 'bc-ca';
 104 is $seq->meta(''), '     ';
 105 is $seq->submeta(2,undef, 'c-c'), 'c-c ';
 106 is $seq->meta, ' c-c ';
 107
 108 # add named meta annotations
 109
 110 my $first = '11-22';
 111 is $seq->named_meta('first', $first), $first;
 112 is $seq->named_meta('first'), $first;
 113
 114 my $second = '[[-]]';
 115 ok $seq->named_meta('second', $second);
 116
 117 # undefined range arguments
 118 is $seq->named_submeta('second', 3, 4), '-]';
 119 is $seq->named_submeta('second', 3), '-]]';
 120 is $seq->named_submeta('second'), '[[-]]';
 121
 122 my @names =  $seq->meta_names;
 123 is @names, 3;
 124 is $names[0], 'DEFAULT';
 125
 126
 127
 128 #
 129 # IO tests
 130 #
 131
 132 sub diff {
 133     my ($infile, $outfile) = @_;
 134     my ($in, $out);
 135     open FH, $infile;
 136     $in .= $_ while (<FH>);
 137     close FH;
 138
 139     open FH, $outfile;
 140     $out .= $_ while (<FH>);
 141     close FH;
 142     print "|$in||$out|\n" if $DEBUG;
 143     is $in, $out;
 144
 145 }
 146
 147
 148 # SeqIO
 149 my $str = Bio::SeqIO->new
 150     ( '-file'=> test_input_file('test.metafasta'),
 151       '-format' => 'metafasta');
 152 ok  $seq = $str->next_seq;
 153
 154 my $outfile = test_output_file();
 155 my $strout = Bio::SeqIO->new
 156     ('-file'=> ">". $outfile,
 157      '-format' => 'metafasta');
 158 ok $strout->write_seq($seq);
 159
 160 diff (test_input_file('test.metafasta'),
 161       $outfile
 162      );
 163
 164 # AlignIO
 165
 166 $str = Bio::AlignIO->new
 167     ( '-file'=> test_input_file('testaln.metafasta'),
 168       '-format' => 'metafasta');
 169 ok my $aln = $str->next_aln;
 170
 171 $outfile = test_output_file();
 172 $strout = Bio::AlignIO->new
 173     ('-file'=> ">". $outfile,
 174      '-format' => 'metafasta');
 175 ok $strout->write_aln($aln);
 176
 177 diff (test_input_file('testaln.metafasta'),
 178       $outfile
 179      );
 180
 181 #
 182 ##
 183 ### tests for Meta::Array
 184 ##
 185 #
 186
 187 ok $seq = Bio::Seq::Meta::Array->new
 188     ( -seq => "",
 189       -meta => "",
 190       -alphabet => 'dna',
 191       -id => 'myid'
 192     );
 193
 194 # create a sequence object
 195 ok $seq = Bio::Seq::Meta::Array->new( -seq => "AT-CGATCGA",
 196                                       -id => 'test',
 197                                       -force_flush => 1,
 198                                       -verbose => 2
 199                              );
 200
 201 is $seq->is_flush, 1;
 202 #is $seq->meta_text, "          ";
 203 is $seq->meta_text, '0 0 0 0 0 0 0 0 0 0';
 204
 205 # create some random meta values, but not for the last residue
 206 $metastring = "a a - b b 0 b b 0";
 207 is join (' ',  @{$seq->meta($metastring)}), $metastring. ' 0';
 208 is $seq->meta_text, $metastring. ' 0';
 209
 210 # truncate the sequence by assignment
 211 $seq->seq('AT-CGA');
 212 $seq->alphabet('dna');
 213 is $seq->meta_text, 'a a - b b 0';
 214
 215 # truncate the sequence with trunc()
 216 is $seq->strand(-1), -1;
 217 ok $seq = $seq->trunc(1,5);
 218 is $seq->seq, 'AT-CG';
 219 is $seq->meta_text, 'a a - b b';
 220 is $seq->strand, -1;
 221
 222 #is $seq->length, 5;
 223 #is $seq->meta_length, 6;
 224 #ok $seq->force_flush(1);
 225 #is $seq->meta_length, 5;
 226
 227 # revcom
 228 ok $seq = $seq->revcom;
 229 is $seq->seq, 'CG-AT';
 230 is $seq->meta_text, 'b b - a a';
 231 is $seq->strand, 1;
 232
 233 # submeta
 234
 235 is $seq->subseq(2,4), 'G-A';
 236
 237 is $seq->submeta_text(2,4), 'b - a';
 238 is $seq->submeta_text(2,undef, 'c - c'), 'c - c';
 239 is $seq->submeta_text(2,4), 'c - c';
 240 is $seq->meta_text, 'b c - c a';
 241
 242 is $seq->meta_text(''), '0 0 0 0 0';
 243 is $seq->submeta_text(2,undef, 'c - c'), 'c - c';
 244 is $seq->meta_text, '0 c - c 0';
 245
 246 # add named meta annotations
 247 $first = '1 10 - 222 23';
 248 is $seq->named_meta_text('first', $first), $first;
 249 is $seq->named_meta_text('first'), $first;
 250 $second = '[ [ - ] ]';
 251 ok $seq->named_meta_text('second', $second);
 252
 253 # undefined range arguments
 254 is $seq->named_submeta_text('second', 3, 4), '- ]';
 255 is $seq->named_submeta_text('second', 3), '- ] ]';
 256 is $seq->named_submeta_text('second'), '[ [ - ] ]';
 257
 258 @names =  $seq->meta_names;
 259 is @names, 3;
 260 is $names[0], 'DEFAULT';
 261
 262
 263
 264
 265 #
 266 # testing the forcing of flushed meta values
 267 #
 268
 269
 270
 271
 272 ok $seq = Bio::Seq::Meta->new( -seq =>  "AT-CGATCGA",
 273                                   -id => 'test',
 274                                   -verbose => 2
 275                              );
 276 is $seq->submeta(4, 6, '456'), '456';
 277 is $seq->meta_length, 6;
 278 is $seq->length, 10;
 279
 280 is $seq->meta, "   456";
 281
 282 ok $seq->force_flush(1);
 283 is $seq->meta, "   456    ";
 284 ok $seq->seq('aaatttc');
 285 is $seq->meta, "   456 ";
 286
 287 ok $seq = Bio::Seq::Meta::Array->new( -seq =>  "AT-CGATCGA",
 288                                   -id => 'test',
 289                                   -verbose => 2
 290                              );
 291 is join (' ', @{$seq->submeta(4, 6, '4 5 6')}), '4 5 6';
 292 is $seq->meta_length, 6;
 293 is $seq->length, 10;
 294
 295 is $seq->meta_text, "0 0 0 4 5 6";
 296 ok $seq->force_flush(1);
 297 is $seq->meta_text, "0 0 0 4 5 6 0 0 0 0";
 298
 299 ok $seq->seq('aaatttc');
 300 is $seq->meta_text, "0 0 0 4 5 6 0";
 301 is $seq->meta_length, 7;
 302
 303
 304 ok  $seq = Bio::Seq::Quality->new( -seq =>  "AT-CGATCGA",
 305                                   -id => 'test',
 306                                   -verbose => 2
 307                              );
 308 is join (' ', @{$seq->submeta(4, 6, '4 5 6')}), '4 5 6';
 309 is $seq->meta_length, 6;
 310 is $seq->length, 10;
 311
 312 is $seq->meta_text, "0 0 0 4 5 6";
 313
 314 ok $seq->force_flush(1);
 315
 316 is $seq->meta_text, "0 0 0 4 5 6 0 0 0 0";
 317
 318 ok $seq->seq('aaatttc');
 319 is $seq->meta_text, "0 0 0 4 5 6 0";
 320 is $seq->meta_length, 7;
 321 is $seq->trace_length, 7;
 322 #is $seq->quality_length, 7;
 323
 324 is $seq->is_flush, 1;
 325 is $seq->trace_is_flush, 1;
 326 is $seq->quality_is_flush, 1;
 327
 328 # quality: trace_lengths, trace_is_flush, quality_is_flush