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