t/Seq/MetaSeq.t

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