t/SeqIO/msout.t

   1 #!/usr/bin/perl -w
   2 use version;
   3 our $API_VERSION = qv('1.1.6');
   4
   5 use strict;
   6 use File::Path qw(mkpath rmtree);
   7
   8 BEGIN {
   9     use lib '.';    # for core package test scripts only
  10     use Bio::Root::Test;
  11
  12     test_begin(
  13         -tests               => 85,
  14         -requires_modules    => [q(Bio::SeqIO::msout)],
  15         -requires_networking => 0
  16     );
  17
  18     use_ok('Bio::SeqIO::msout');
  19
  20 }
  21
  22 # skip tests if the msout.pm module is too old.
  23 my $api_version = $Bio::SeqIO::msout::API_VERSION;
  24 cmp_ok( $api_version,
  25     '>=', qv('1.1.5'), "Bio::SeqIO::msout is at least api version 1.1.5" );
  26
  27 test_file_1( 0, "msout/msout_infile1" );
  28 test_file_2( 0, "msout/msout_infile2" );
  29 test_file_3( 0, "msout/msout_infile3" );
  30
  31 # tests to run for api versions >= 1.1.6
  32 SKIP: {
  33     skip q($Bio::SeqIO::msout::API_VERSION < 1.1.6) , 22 unless $api_version >= qv('1.1.6');
  34     test_file_4( 0, q(msout/msout_infile4) );
  35 }
  36
  37 sub create_dir {
  38
  39     my $dir = shift;
  40
  41     $dir = test_input_file($dir);
  42
  43     unless ( -d $dir ) {
  44         mkpath($dir);
  45     }
  46 }
  47
  48 sub remove_dir {
  49
  50     my $dir = shift;
  51
  52     $dir = test_input_file($dir);
  53
  54     if ( -d $dir ) {
  55         rmtree($dir);
  56     }
  57     else { warn "Tried to remove $dir, but it does not exist" }
  58 }
  59
  60 sub test_file_1 {
  61 ##############################################################################
  62 ## Test file 1
  63 ##############################################################################
  64
  65     my $gzip   = shift;
  66     my $infile = shift;
  67     $infile = test_input_file($infile);
  68
  69     #print_file1( $infile, $gzip );
  70
  71     my $file_sequence = $infile;
  72     if ($gzip) {
  73         $file_sequence = "gunzip -c <$file_sequence |";
  74     }
  75     my $msout = Bio::SeqIO->new(
  76         -file   => "$file_sequence",
  77         -format => 'msout',
  78     );
  79
  80     isa_ok( $msout, 'Bio::SeqIO::msout' );
  81
  82     my $rh_base_conversion_table = $msout->get_base_conversion_table;
  83
  84     my %attributes = (
  85         RUNS              => 3,
  86         SEGSITES          => 7,
  87         SEEDS             => [qw(1 1 1)],
  88         MS_INFO_LINE      => 'ms 6 3 -s 7 -I 3 3 2 1',
  89         TOT_RUN_HAPS      => 6,
  90         POPS              => [qw(3 2 1)],
  91         NEXT_RUN_NUM      => 1,
  92         LAST_READ_HAP_NUM => 0,
  93         POSITIONS => [qw(79.1001 80.1001 81.101 82.101 83.10001 84.801 85)],
  94         CURRENT_RUN_SEGSITES => 7
  95     );
  96
  97     foreach my $attribute ( keys %attributes ) {
  98         my $func = lc($attribute);
  99
 100         if ( $attribute =~ m/POPS|SEEDS|POSITIONS/ ) {
 101             $func = ucfirst($func);
 102         }
 103
 104         $func = 'get_' . $func;
 105         my @returns = $msout->$func();
 106         my ( $return, $got );
 107
 108         # If there were more than one return value, then compare references to
 109         # arrays instead of scalars
 110         unless ( @returns > 1 ) {
 111             $got = shift @returns;
 112         }
 113         else { $got = \@returns }
 114
 115         my $expected = $attributes{$attribute};
 116
 117         if ( defined $got && defined $expected ) {
 118             is_deeply( $got, $expected, "Get $attribute" );
 119         }
 120         else { is_deeply( $got, $expected, "Get $attribute" ) }
 121     }
 122
 123     # Testing next_hap at beginning of run
 124     my @data_got =
 125       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
 126     my @data_expected = qw(1111111);
 127     is_deeply( \@data_got, \@data_expected,
 128         "Get next_hap at beginning of run" );
 129
 130     # Testing next_hap after beginning of run
 131     @data_got =
 132       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
 133     @data_expected = qw(5555555);
 134     is_deeply( \@data_got, \@data_expected,
 135         "Get next_hap after beginning of run" );
 136
 137     # Surprise test! testing msout::outgroup
 138     my $outgroup = $msout->outgroup;
 139     is( $outgroup, 1, "Testing msout::outgroup" );
 140
 141     # Testing next_pop after beginning of pop
 142     @data_got =
 143       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
 144     @data_expected = qw(4444444);
 145     is_deeply( \@data_got, \@data_expected,
 146         "Get next_pop after beginning of pop" );
 147
 148     # Testing next_pop at beginning of pop
 149     @data_got =
 150       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
 151     @data_expected = qw(4444444 5555555);
 152     is_deeply( \@data_got, \@data_expected,
 153         "Get next_pop at beginning of pop" );
 154
 155     # Testing next_run after beginning of run
 156     @data_got =
 157       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
 158     @data_expected = qw(4444444);
 159     is_deeply( \@data_got, \@data_expected,
 160         "Get next_run after beginning of run" );
 161
 162     # Testing next_pop at beginning of run
 163     @data_got =
 164       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
 165     @data_expected = qw(5555555 5555555 5555555);
 166     is_deeply( \@data_got, \@data_expected,
 167         "Get next_pop at beginning of run" );
 168
 169     # Testing next_hap after pop
 170     @data_got      = $msout->get_next_hap;
 171     @data_expected = qw(1010101);
 172     is_deeply( \@data_got, \@data_expected, "Get next_hap after pop" );
 173
 174     # Testing next_run after pop and hap
 175     @data_got =
 176       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
 177     @data_expected = qw(1111111 1515151);
 178     is_deeply( \@data_got, \@data_expected, "Get next_run after pop and hap" );
 179
 180     # Testing next_run at beginning of run
 181     @data_got =
 182       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
 183     @data_expected = qw(
 184       1414141
 185       1414141
 186       1515151
 187       1414141
 188       1515151
 189       1515151);
 190     is_deeply( \@data_got, \@data_expected,
 191         "Get next_run at beginning of run" );
 192
 193     is( $msout->get_next_run_num, undef, 'have all lines been read?' );
 194 }
 195
 196 sub test_file_2 {
 197 ##############################################################################
 198 ## Test file 2
 199 ##############################################################################
 200
 201     my $gzip   = shift;
 202     my $infile = shift;
 203     $infile = test_input_file($infile);
 204
 205     #print_file2( $infile, $gzip );
 206
 207     my $file_sequence = $infile;
 208     if ($gzip) {
 209         $file_sequence = "gunzip -c <$file_sequence |";
 210     }
 211
 212     my $msout = Bio::SeqIO->new(
 213         -file   => "$file_sequence",
 214         -format => 'msout',
 215     );
 216
 217     isa_ok( $msout, 'Bio::SeqIO::msout' );
 218
 219     my %attributes = (
 220         RUNS              => 3,
 221         SEGSITES          => 7,
 222         SEEDS             => [qw(1 1 1)],
 223         MS_INFO_LINE      => 'ms 6 3',
 224         TOT_RUN_HAPS      => 6,
 225         POPS              => 6,
 226         NEXT_RUN_NUM      => 1,
 227         LAST_READ_HAP_NUM => 0,
 228         POSITIONS => [qw(79.1001 80.1001 81.101 82.101 83.10001 84.801 85)],
 229         CURRENT_RUN_SEGSITES => 7
 230     );
 231
 232     foreach my $attribute ( keys %attributes ) {
 233         my $func = lc($attribute);
 234
 235         if ( $attribute =~ m/POPS|SEEDS|POSITIONS/ ) {
 236             $func = ucfirst($func);
 237         }
 238
 239         $func = 'get_' . $func;
 240         my @returns = $msout->$func();
 241         my ( $return, $got );
 242
 243         # If there were more than one return value, then compare references to
 244         # arrays instead of scalars
 245         unless ( @returns > 1 ) {
 246             $got = shift @returns;
 247         }
 248         else { $got = \@returns }
 249
 250         my $expected = $attributes{$attribute};
 251
 252         if ( defined $got && defined $expected ) {
 253             is_deeply( $got, $expected, "Get $attribute" );
 254         }
 255         else { is_deeply( $got, $expected, "Get $attribute" ) }
 256     }
 257
 258     my $rh_base_conversion_table = $msout->get_base_conversion_table;
 259
 260     # Testing next_hap at beginning of run
 261     my @data_got      = $msout->get_next_hap;
 262     my @data_expected = '1111111';
 263     is_deeply( \@data_got, \@data_expected,
 264         "Get next_hap at beginning of run" );
 265
 266     # Testing next_hap after beginning of run
 267     @data_got =
 268       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
 269     @data_expected = '5555555';
 270     is_deeply( \@data_got, \@data_expected,
 271         "Get next_hap after beginning of run" );
 272
 273     # Surprise test! testing msout::outgroup
 274     my $outgroup = $msout->outgroup;
 275     is( $outgroup, 0, "Testing msout::outgroup" );
 276
 277     # Testing next_pop after beginning of pop
 278     @data_got =
 279       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
 280     @data_expected = qw(
 281       4444444
 282       4444444
 283       5555555
 284       4444444);
 285     is_deeply( \@data_got, \@data_expected,
 286         "Get next_pop after beginning of pop" );
 287
 288     # Testing next_pop at beginning of pop/run
 289     @data_got =
 290       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
 291     @data_expected = qw(
 292       5555555
 293       5555555
 294       5555555
 295       1010101
 296       1111111
 297       1515151);
 298     is_deeply( \@data_got, \@data_expected,
 299         "Get next_pop at beginning of pop/run" );
 300
 301     # Testing next_run at beginning of run
 302     @data_got =
 303       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
 304     @data_expected = qw(
 305       1414141
 306       1414141
 307       1515151
 308       1414141
 309       1515151
 310       1515151);
 311     is_deeply( \@data_got, \@data_expected,
 312         "Get next_run at beginning of run" );
 313
 314     # Testing next_hap at beginning of run 2
 315     @data_got =
 316       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
 317     @data_expected = '1515151';
 318     is_deeply( \@data_got, \@data_expected,
 319         "Get next_hap at beginning of run 2" );
 320
 321     # Testing next_run after hap
 322     @data_got =
 323       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
 324     @data_expected = qw(
 325       5050505
 326       5151515
 327       5555555
 328       5454545
 329       5454545);
 330     is_deeply( \@data_got, \@data_expected, "Get next_run after hap" );
 331
 332     is( $msout->get_next_run_num, 5, 'next run should be 5.' );
 333
 334     # getting the last hap of the file via next hap
 335     # Testing next_run after hap
 336     @data_got      = $msout->get_next_hap;
 337     @data_expected = qw( 5555555 );
 338     is_deeply( \@data_got, \@data_expected, "Get last hap through next_hap" );
 339
 340 }
 341
 342 sub test_file_3 {
 343 ##############################################################################
 344 ## Test file 3
 345 ##############################################################################
 346
 347     my $gzip   = shift;
 348     my $infile = shift;
 349     $infile = test_input_file($infile);
 350
 351     #print_file3( $infile, $gzip );
 352
 353     my $file_sequence = $infile;
 354     if ($gzip) {
 355         $file_sequence = "gunzip -c <$file_sequence |";
 356     }
 357     my $msout = Bio::SeqIO->new(
 358         -file   => "$file_sequence",
 359         -format => 'msout',
 360     );
 361
 362     isa_ok( $msout, 'Bio::SeqIO::msout' );
 363
 364     my $rh_base_conversion_table = $msout->get_base_conversion_table;
 365
 366     isa_ok( $msout, 'Bio::SeqIO::msout' );
 367
 368     my %attributes = (
 369         RUNS              => 1,
 370         SEGSITES          => 7,
 371         SEEDS             => [qw(1 1 1)],
 372         MS_INFO_LINE      => 'ms 3 1',
 373         TOT_RUN_HAPS      => 3,
 374         POPS              => 3,
 375         NEXT_RUN_NUM      => 1,
 376         LAST_READ_HAP_NUM => 0,
 377         POSITIONS => [qw(79.1001 80.1001 81.101 82.101 83.10001 84.801 85)],
 378         CURRENT_RUN_SEGSITES => 7
 379     );
 380
 381     foreach my $attribute ( keys %attributes ) {
 382         my $func = lc($attribute);
 383
 384         if ( $attribute =~ m/POPS|SEEDS|POSITIONS/ ) {
 385             $func = ucfirst($func);
 386         }
 387
 388         $func = 'get_' . $func;
 389         my @returns = $msout->$func();
 390         my ( $return, $got );
 391
 392         # If there were more than one return value, then compare references to
 393         # arrays instead of scalars
 394         unless ( @returns > 1 ) {
 395             $got = shift @returns;
 396         }
 397         else { $got = \@returns }
 398
 399         my $expected = $attributes{$attribute};
 400
 401         if ( defined $got && defined $expected ) {
 402             is_deeply( $got, $expected, "Get $attribute" );
 403         }
 404         else { is_deeply( $got, $expected, "Get $attribute" ) }
 405     }
 406
 407     # Testing next_hap at beginning of run
 408     my @data_got =
 409       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
 410     my @data_expected = qw(1111111 5555555 4444444);
 411     is_deeply( \@data_got, \@data_expected, "Get next_pop at end of run" );
 412
 413     is( $msout->get_next_run_num, undef, 'have all lines been read?' );
 414
 415     # Testing what happens when we read from empty stream
 416     @data_got      = $msout->get_next_pop;
 417     @data_expected = ();
 418     is_deeply( \@data_got, \@data_expected, "Get next_pop at eof" );
 419
 420     # Testing what happens when we read from empty stream
 421     @data_got      = $msout->get_next_run;
 422     @data_expected = ();
 423     is_deeply( \@data_got, \@data_expected, "Get next_run at eof" );
 424
 425     # Testing what happens when we read from empty stream
 426     @data_got      = $msout->get_next_hap;
 427     @data_expected = undef;
 428     is_deeply( \@data_got, \@data_expected, "Get next_hap at eof" );
 429
 430     # Testing what happens when we read from empty stream
 431     @data_got      = $msout->get_next_seq;
 432     @data_expected = ();
 433     is_deeply( \@data_got, \@data_expected, "Get next_seq at eof" );
 434
 435 }
 436
 437 sub test_file_4 {
 438 ##############################################################################
 439 ## Test file 4
 440 ##############################################################################
 441
 442 # All this does is test to see if Bio::SeqIO::msout can handle ms output files
 443 # with multiple newline characters randomly interspersed in the file.
 444
 445     my $gzip   = shift;
 446     my $infile = shift;
 447     $infile = test_input_file($infile);
 448
 449     #print_file4( $infile, $gzip );
 450
 451     my $file_sequence = $infile;
 452     if ($gzip) {
 453         $file_sequence = "gunzip -c <$file_sequence |";
 454     }
 455     my $msout = Bio::SeqIO->new(
 456         -file   => "$file_sequence",
 457         -format => 'msout',
 458     );
 459
 460     isa_ok( $msout, 'Bio::SeqIO::msout' );
 461
 462     my $rh_base_conversion_table = $msout->get_base_conversion_table;
 463
 464     my %attributes = (
 465         RUNS              => 3,
 466         SEGSITES          => 7,
 467         SEEDS             => [qw(1 1 1)],
 468         MS_INFO_LINE      => 'ms 6 3 -s 7 -I 3 3 2 1',
 469         TOT_RUN_HAPS      => 6,
 470         POPS              => [qw(3 2 1)],
 471         NEXT_RUN_NUM      => 1,
 472         LAST_READ_HAP_NUM => 0,
 473         POSITIONS => [qw(79.1001 80.1001 81.101 82.101 83.10001 84.801 85)],
 474         CURRENT_RUN_SEGSITES => 7
 475     );
 476
 477     foreach my $attribute ( keys %attributes ) {
 478         my $func = lc($attribute);
 479
 480         if ( $attribute =~ m/POPS|SEEDS|POSITIONS/ ) {
 481             $func = ucfirst($func);
 482         }
 483
 484         $func = 'get_' . $func;
 485         my @returns = $msout->$func();
 486         my ( $return, $got );
 487
 488         # If there were more than one return value, then compare references to
 489         # arrays instead of scalars
 490         unless ( @returns > 1 ) {
 491             $got = shift @returns;
 492         }
 493         else { $got = \@returns }
 494
 495         my $expected = $attributes{$attribute};
 496
 497         if ( defined $got && defined $expected ) {
 498             is_deeply( $got, $expected, "Get $attribute" );
 499         }
 500         else { is_deeply( $got, $expected, "Get $attribute" ) }
 501     }
 502
 503     # Testing next_hap at beginning of run
 504     my @data_got =
 505       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
 506     my @data_expected = qw(1111111);
 507     is_deeply( \@data_got, \@data_expected,
 508         "Get next_hap at beginning of run" );
 509
 510     # Testing next_hap after beginning of run
 511     @data_got =
 512       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
 513     @data_expected = qw(5555555);
 514     is_deeply( \@data_got, \@data_expected,
 515         "Get next_hap after beginning of run" );
 516
 517     # Surprise test! testing msout::outgroup
 518     my $outgroup = $msout->outgroup;
 519     is( $outgroup, 1, "Testing msout::outgroup" );
 520
 521     # Testing next_pop after beginning of pop
 522     @data_got =
 523       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
 524     @data_expected = qw(4444444);
 525     is_deeply( \@data_got, \@data_expected,
 526         "Get next_pop after beginning of pop" );
 527
 528     # Testing next_pop at beginning of pop
 529     @data_got =
 530       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
 531     @data_expected = qw(4444444 5555555);
 532     is_deeply( \@data_got, \@data_expected,
 533         "Get next_pop at beginning of pop" );
 534
 535     # Testing next_run after beginning of run
 536     @data_got =
 537       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
 538     @data_expected = qw(4444444);
 539     is_deeply( \@data_got, \@data_expected,
 540         "Get next_run after beginning of run" );
 541
 542     # Testing next_pop at beginning of run
 543     @data_got =
 544       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
 545     @data_expected = qw(5555555 5555555 5555555);
 546     is_deeply( \@data_got, \@data_expected,
 547         "Get next_pop at beginning of run" );
 548
 549     # Testing next_hap after pop
 550     @data_got      = $msout->get_next_hap;
 551     @data_expected = qw(1010101);
 552     is_deeply( \@data_got, \@data_expected, "Get next_hap after pop" );
 553
 554     # Testing next_run after pop and hap
 555     @data_got =
 556       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
 557     @data_expected = qw(1111111 1515151);
 558     is_deeply( \@data_got, \@data_expected, "Get next_run after pop and hap" );
 559
 560     # Testing next_run at beginning of run
 561     @data_got =
 562       convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
 563     @data_expected = qw(
 564       1414141
 565       1414141
 566       1515151
 567       1414141
 568       1515151
 569       1515151);
 570     is_deeply( \@data_got, \@data_expected,
 571         "Get next_run at beginning of run" );
 572
 573     is( $msout->get_next_run_num, undef, 'have all lines been read?' );
 574 }
 575
 576 sub print_file1 {
 577
 578     my $destination = shift;
 579     my $gzip        = shift;
 580
 581     my $out = <<END
 582 ms 6 3 -s 7 -I 3 3 2 1
 583 1 1 1
 584
 585 //
 586 segsites: 7
 587 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 588 1111111
 589 5555555
 590 4444444
 591 4444444
 592 5555555
 593 4444444
 594 //
 595 segsites: 7
 596 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 597 5555555
 598 5555555
 599 5555555
 600 1010101
 601 1111111
 602 1515151
 603 //
 604 segsites: 7
 605 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 606 1414141
 607 1414141
 608 1515151
 609 1414141
 610 1515151
 611 1515151
 612 END
 613       ;
 614
 615     if ($gzip) {
 616         $gzip = "| gzip";
 617     }
 618     else { $gzip = ' '; }
 619     open OUT, "$gzip >$destination" or die "Unable to open $destination\n";
 620
 621     print OUT $out;
 622     close OUT;
 623 }
 624
 625 sub print_file2 {
 626
 627     my $destination = shift;
 628     my $gzip        = shift;
 629
 630     my $out = <<END
 631 ms 6 3
 632 1 1 1
 633
 634 //
 635 segsites: 7
 636 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 637 1111111
 638 5555555
 639 4444444
 640 4444444
 641 5555555
 642 4444444
 643 //
 644 segsites: 7
 645 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 646 5555555
 647 5555555
 648 5555555
 649 1010101
 650 1111111
 651 1515151
 652 //
 653 segsites: 7
 654 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 655 1414141
 656 1414141
 657 1515151
 658 1414141
 659 1515151
 660 1515151
 661 //
 662 segsites: 7
 663 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 664 1515151
 665 5050505
 666 5151515
 667 5555555
 668 5454545
 669 5454545
 670 //
 671 segsites: 7
 672 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 673 5555555
 674 END
 675       ;
 676
 677     if ($gzip) {
 678         $gzip = "| gzip";
 679     }
 680     else { $gzip = ' '; }
 681
 682     open OUT, "$gzip >$destination" or die "Unable to open $destination\n";
 683
 684     print OUT $out;
 685     close OUT;
 686 }
 687
 688 sub print_file3 {
 689
 690     my $destination = shift;
 691     my $gzip        = shift;
 692
 693     my $out = <<END ;
 694 ms 3 1
 695 1 1 1
 696
 697 //
 698 segsites: 7
 699 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 700 1111111
 701 5555555
 702 4444444
 703 END
 704
 705     if ($gzip) {
 706         $gzip = "| gzip";
 707     }
 708     else { $gzip = ' '; }
 709
 710     open OUT, "$gzip >$destination" or die "Unable to open $destination\n";
 711
 712     print OUT $out;
 713     close OUT;
 714 }
 715
 716 sub print_file4 {
 717
 718     my $destination = shift;
 719     my $gzip        = shift;
 720
 721     my $out = <<END
 722
 723
 724
 725
 726 ms 6 3 -s 7 -I 3 3 2 1
 727
 728
 729
 730 1 1 1
 731
 732 //
 733
 734 segsites: 7
 735
 736
 737 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 738
 739
 740 1111111
 741 5555555
 742
 743
 744 4444444
 745
 746 4444444
 747 5555555
 748
 749 4444444
 750
 751
 752 //
 753
 754 segsites: 7
 755 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 756 5555555
 757 5555555
 758
 759
 760
 761 5555555
 762 1010101
 763 1111111
 764 1515151
 765
 766 //
 767 segsites: 7
 768
 769
 770
 771 positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
 772
 773 1414141
 774 1414141
 775 1515151
 776 1414141
 777 1515151
 778 1515151
 779
 780
 781
 782
 783
 784 END
 785       ;
 786
 787     if ($gzip) {
 788         $gzip = "| gzip";
 789     }
 790     else { $gzip = ' '; }
 791     open OUT, "$gzip >$destination" or die "Unable to open $destination\n";
 792
 793     print OUT $out;
 794     close OUT;
 795 }
 796
 797
 798 sub print_to_file {
 799     my ( $ra_in, $out ) = @_;
 800     unless ( open OUT, ">$out" ) {
 801         die "\nCould not open outfile $out!!\n\n";
 802     }
 803     print OUT ("@$ra_in");
 804     close OUT;
 805 }
 806
 807 sub convert_bases_to_nums {
 808
 809     my ( $rh_base_conversion_table, @seqs ) = @_;
 810
 811     my @out_seqstrings;
 812     foreach my $seq (@seqs) {
 813         my $seqstring = $seq->seq;
 814         foreach my $base ( keys %{$rh_base_conversion_table} ) {
 815             $seqstring =~ s/($base)/$rh_base_conversion_table->{$base}/g;
 816         }
 817         push @out_seqstrings, $seqstring;
 818     }
 819
 820     return @out_seqstrings;
 821
 822 }