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 my $FH_IN, '<', $infile or die "Could not read file '$infile': $!\n";
 136     $in .= $_ while (<$FH_IN>);
 137     close $FH_IN;
 138
 139     open my $FH_OUT, '<', $outfile or die "Could not read file '$outfile': $!\n";
 140     $out .= $_ while (<$FH_OUT>);
 141     close $FH_OUT;
 142     print "|$in||$out|\n" if $DEBUG;
 143     is $in, $out;
 144 }
 145
 146
 147 # SeqIO
 148 my $str = Bio::SeqIO->new
 149     ( '-file'=> test_input_file('test.metafasta'),
 150       '-format' => 'metafasta');
 151 ok  $seq = $str->next_seq;
 152
 153 my $outfile = test_output_file();
 154 my $strout = Bio::SeqIO->new
 155     ('-file'=> ">". $outfile,
 156      '-format' => 'metafasta');
 157 ok $strout->write_seq($seq);
 158
 159 diff (test_input_file('test.metafasta'),
 160       $outfile
 161      );
 162
 163 # AlignIO
 164
 165 $str = Bio::AlignIO->new
 166     ( '-file'=> test_input_file('testaln.metafasta'),
 167       '-format' => 'metafasta');
 168 ok my $aln = $str->next_aln;
 169
 170 $outfile = test_output_file();
 171 $strout = Bio::AlignIO->new
 172     ('-file'=> ">". $outfile,
 173      '-format' => 'metafasta');
 174 ok $strout->write_aln($aln);
 175
 176 diff (test_input_file('testaln.metafasta'),
 177       $outfile
 178      );
 179
 180 #
 181 ##
 182 ### tests for Meta::Array
 183 ##
 184 #
 185
 186 ok $seq = Bio::Seq::Meta::Array->new
 187     ( -seq => "",
 188       -meta => "",
 189       -alphabet => 'dna',
 190       -id => 'myid'
 191     );
 192
 193 # create a sequence object
 194 ok $seq = Bio::Seq::Meta::Array->new( -seq => "AT-CGATCGA",
 195                                       -id => 'test',
 196                                       -force_flush => 1,
 197                                       -verbose => 2
 198                              );
 199
 200 is $seq->is_flush, 1;
 201 #is $seq->meta_text, "          ";
 202 is $seq->meta_text, '0 0 0 0 0 0 0 0 0 0';
 203
 204 # create some random meta values, but not for the last residue
 205 $metastring = "a a - b b 0 b b 0";
 206 is join (' ',  @{$seq->meta($metastring)}), $metastring. ' 0';
 207 is $seq->meta_text, $metastring. ' 0';
 208
 209 # truncate the sequence by assignment
 210 $seq->seq('AT-CGA');
 211 $seq->alphabet('dna');
 212 is $seq->meta_text, 'a a - b b 0';
 213
 214 # truncate the sequence with trunc()
 215 is $seq->strand(-1), -1;
 216 ok $seq = $seq->trunc(1,5);
 217 is $seq->seq, 'AT-CG';
 218 is $seq->meta_text, 'a a - b b';
 219 is $seq->strand, -1;
 220
 221 #is $seq->length, 5;
 222 #is $seq->meta_length, 6;
 223 #ok $seq->force_flush(1);
 224 #is $seq->meta_length, 5;
 225
 226 # revcom
 227 ok $seq = $seq->revcom;
 228 is $seq->seq, 'CG-AT';
 229 is $seq->meta_text, 'b b - a a';
 230 is $seq->strand, 1;
 231
 232 # submeta
 233
 234 is $seq->subseq(2,4), 'G-A';
 235
 236 is $seq->submeta_text(2,4), 'b - a';
 237 is $seq->submeta_text(2,undef, 'c - c'), 'c - c';
 238 is $seq->submeta_text(2,4), 'c - c';
 239 is $seq->meta_text, 'b c - c a';
 240
 241 is $seq->meta_text(''), '0 0 0 0 0';
 242 is $seq->submeta_text(2,undef, 'c - c'), 'c - c';
 243 is $seq->meta_text, '0 c - c 0';
 244
 245 # add named meta annotations
 246 $first = '1 10 - 222 23';
 247 is $seq->named_meta_text('first', $first), $first;
 248 is $seq->named_meta_text('first'), $first;
 249 $second = '[ [ - ] ]';
 250 ok $seq->named_meta_text('second', $second);
 251
 252 # undefined range arguments
 253 is $seq->named_submeta_text('second', 3, 4), '- ]';
 254 is $seq->named_submeta_text('second', 3), '- ] ]';
 255 is $seq->named_submeta_text('second'), '[ [ - ] ]';
 256
 257 @names =  $seq->meta_names;
 258 is @names, 3;
 259 is $names[0], 'DEFAULT';
 260
 261
 262
 263
 264 #
 265 # testing the forcing of flushed meta values
 266 #
 267
 268
 269
 270
 271 ok $seq = Bio::Seq::Meta->new( -seq =>  "AT-CGATCGA",
 272                                   -id => 'test',
 273                                   -verbose => 2
 274                              );
 275 is $seq->submeta(4, 6, '456'), '456';
 276 is $seq->meta_length, 6;
 277 is $seq->length, 10;
 278
 279 is $seq->meta, "   456";
 280
 281 ok $seq->force_flush(1);
 282 is $seq->meta, "   456    ";
 283 ok $seq->seq('aaatttc');
 284 is $seq->meta, "   456 ";
 285
 286 ok $seq = Bio::Seq::Meta::Array->new( -seq =>  "AT-CGATCGA",
 287                                   -id => 'test',
 288                                   -verbose => 2
 289                              );
 290 is join (' ', @{$seq->submeta(4, 6, '4 5 6')}), '4 5 6';
 291 is $seq->meta_length, 6;
 292 is $seq->length, 10;
 293
 294 is $seq->meta_text, "0 0 0 4 5 6";
 295 ok $seq->force_flush(1);
 296 is $seq->meta_text, "0 0 0 4 5 6 0 0 0 0";
 297
 298 ok $seq->seq('aaatttc');
 299 is $seq->meta_text, "0 0 0 4 5 6 0";
 300 is $seq->meta_length, 7;
 301
 302
 303 ok  $seq = Bio::Seq::Quality->new( -seq =>  "AT-CGATCGA",
 304                                   -id => 'test',
 305                                   -verbose => 2
 306                              );
 307 is join (' ', @{$seq->submeta(4, 6, '4 5 6')}), '4 5 6';
 308 is $seq->meta_length, 6;
 309 is $seq->length, 10;
 310
 311 is $seq->meta_text, "0 0 0 4 5 6";
 312
 313 ok $seq->force_flush(1);
 314
 315 is $seq->meta_text, "0 0 0 4 5 6 0 0 0 0";
 316
 317 ok $seq->seq('aaatttc');
 318 is $seq->meta_text, "0 0 0 4 5 6 0";
 319 is $seq->meta_length, 7;
 320 is $seq->trace_length, 7;
 321 #is $seq->quality_length, 7;
 322
 323 is $seq->is_flush, 1;
 324 is $seq->trace_is_flush, 1;
 325 is $seq->quality_is_flush, 1;
 326
 327 # quality: trace_lengths, trace_is_flush, quality_is_flush