t/seqwithquality.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7         use lib 't/lib';
   8     use BioperlTest;
   9
  10     test_begin(-tests => 22);
  11
  12         use_ok('Bio::Seq::SeqWithQuality');
  13         use_ok('Bio::PrimarySeq');
  14         use_ok('Bio::Seq::PrimaryQual');
  15 }
  16
  17 my $DEBUG = test_debug();
  18
  19 my $verbosity = $DEBUG || -1;
  20
  21 # create some random sequence object with no id
  22 my $seqobj_broken = Bio::PrimarySeq->new( -seq => "ATCGATCGA");
  23
  24 ok my $seqobj = Bio::PrimarySeq->new( -seq => "ATCGATCGA",
  25                             -id  => 'QualityFragment-12',
  26                             -accession_number => 'X78121',
  27                             -verbose => $verbosity);
  28
  29 # create some random quality object with the same number of qualities and the same identifiers
  30 my $string_quals = "10 20 30 40 50 40 30 20 10";
  31 my $indices = "5 10 15 20 25 30 35 40 45";
  32 my $qualobj;
  33 eval {
  34 $qualobj = Bio::Seq::PrimaryQual->new( -qual => $string_quals,
  35                             -id  => 'QualityFragment-12',
  36                             -accession_number => 'X78121',
  37                             -verbose => $verbosity);
  38 };
  39 ok(!$@);
  40
  41
  42 # check to see what happens when you construct the SeqWithQuality object
  43 my $swq1 = Bio::Seq::SeqWithQuality->new( -seq  =>      $seqobj,
  44                                          -verbose => $verbosity,
  45                                         -qual           =>      $qualobj);
  46 ok(!$@);
  47 no warnings;
  48
  49 print("Testing various weird constructors...\n") if $DEBUG;
  50 print("\ta) No ids, Sequence object, no quality...\n") if $DEBUG;
  51 # w for weird
  52 my $wswq1;
  53 eval {
  54         $wswq1 = Bio::Seq::SeqWithQuality->new( -seq  =>        $seqobj,
  55                                                 -verbose => $verbosity,
  56                                                 -qual   =>      "");
  57 };
  58 ok(!$@);
  59
  60 print("\tb) No ids, no sequence, quality object...\n") if $DEBUG;
  61         # note that you must provide a alphabet for this one.
  62 $wswq1 = Bio::Seq::SeqWithQuality->new( -seq => "",
  63                                         -verbose => $verbosity,
  64                                         -qual => $qualobj,
  65                                         -alphabet => 'dna'
  66 );
  67 print("\tc) Absolutely nothing. (HAHAHAHA)...\n") if $DEBUG;
  68 eval {
  69         $wswq1 = Bio::Seq::SeqWithQuality->new( -seq => "",
  70                                                 -verbose => $verbosity,
  71                                                 -qual => "",
  72                                                 -alphabet => 'dna'
  73         );
  74 };
  75 ok(!$@);
  76 print("\td) Absolutely nothing but an ID\n") if $DEBUG;
  77 eval {
  78         $wswq1 = Bio::Seq::SeqWithQuality->new( -seq => "",
  79                                                 -verbose => $verbosity,
  80                                                 -qual => "",
  81                                                 -alphabet => 'dna',
  82                                                 -id => 'an object with no sequence and no quality but with an id'
  83         );
  84 };
  85 ok(!$@);
  86
  87 print("\td) No sequence, No quality, No ID...\n") if $DEBUG;
  88
  89 eval {
  90         $wswq1 = Bio::Seq::SeqWithQuality->new( -seq  =>        "",
  91                                                 -verbose => $verbosity,
  92                                                         -qual   =>      "");
  93 };
  94 # this should fail without a alphabet
  95 ok($@);
  96
  97 print("Testing various methods and behaviors...\n") if $DEBUG;
  98
  99 print("1. Testing the seq() method...\n") if $DEBUG;
 100         print("\t1a) get\n") if $DEBUG;
 101         my $original_seq = $swq1->seq();
 102         is ($original_seq, "ATCGATCGA");
 103         print("\t1b) set\n") if $DEBUG;
 104         ok ($swq1->seq("AAAAAAAAAAAA"));
 105         print("\t1c) get (again, to make sure the set was done.)\n") if $DEBUG;
 106         is ($swq1->seq(), "AAAAAAAAAAAA");
 107         print("\tSetting the sequence back to the original value...\n") if $DEBUG;
 108         $swq1->seq($original_seq);
 109
 110 print("2. Testing the qual() method...\n") if $DEBUG;
 111         print("\t2a) get\n") if $DEBUG;
 112         my @qual = @{$swq1->qual()};
 113         my $str_qual = join(' ',@qual);
 114         is ($str_qual, "10 20 30 40 50 40 30 20 10");
 115         print("\t2b) set\n") if $DEBUG;
 116         ok ($swq1->qual("10 10 10 10 10"));
 117         print("\t2c) get (again, to make sure the set was done.)\n") if $DEBUG;
 118         my @qual2 = @{$swq1->qual()};
 119         my $str_qual2 = join(' ',@qual2);
 120         is($str_qual2, "10 10 10 10 10");
 121         print("\tSetting the quality back to the original value...\n") if $DEBUG;
 122         $swq1->qual($str_qual);
 123
 124 print("3. Testing the length() method...\n") if $DEBUG;
 125         print("\t3a) When lengths are equal...\n") if $DEBUG;
 126         is($swq1->length(), 9);
 127         print("\t3b) When lengths are different\n") if $DEBUG;
 128         $swq1->qual("10 10 10 10 10");
 129         is($swq1->length(), "DIFFERENT");
 130
 131
 132 print("4. Testing the qual_obj() method...\n") if $DEBUG;
 133         print("\t4a) Testing qual_obj()...\n") if $DEBUG;
 134                 my $retr_qual_obj = $swq1->qual_obj();
 135                 isa_ok $retr_qual_obj, "Bio::Seq::PrimaryQual";
 136         print("\t4b) Testing qual_obj(\$ref)...\n") if $DEBUG;
 137                 $swq1->qual_obj($qualobj);
 138
 139 print("5. Testing the seq_obj() method...\n") if $DEBUG;
 140         print("\t5a) Testing seq_qual_obj()...\n") if $DEBUG;
 141                 my $retr_seq_obj = $swq1->seq_obj();
 142                 isa_ok $retr_seq_obj, "Bio::PrimarySeq";
 143         print("\t5b) Testing seq_obj(\$ref)...\n") if $DEBUG;
 144                 $swq1->seq_obj($seqobj);
 145
 146 print("6. Testing the subqual() method...\n") if $DEBUG;
 147      my $t_subqual = "10 20 30 40 50 60 70 80 90";
 148      $swq1->qual($t_subqual);
 149      print("\t6d) Testing the subqual at the start (border condition)\n") if $DEBUG;
 150           # ok ('1 2 3' eq join(' ',@{$swq1->subqual(1,3)}));
 151      print("\t6d) Testing the subqual at the end (border condition)\n") if $DEBUG;
 152           # ok ('7 8 9' eq join(' ',@{$swq1->subqual(7,9)}));
 153      print("\t6d) Testing the subqual in the middle\n") if $DEBUG;
 154           # ok ('4 5 6' eq join(' ',@{$swq1->subqual(4,6)}));
 155
 156
 157 print("7. Testing cases where quality is zero...\n") if $DEBUG;
 158 $swq1 = Bio::Seq::SeqWithQuality->new(-seq =>  'G',
 159                                       -qual => '0',
 160                                       -verbose => $verbosity,
 161                                      );
 162 my $swq2 = Bio::Seq::SeqWithQuality->new(-seq =>  'G',
 163                                          -qual => '65',
 164                                          -verbose => $verbosity,
 165                                      );
 166 is $swq1->length, $swq2->length;
 167
 168 $swq1 = Bio::Seq::SeqWithQuality->new(-seq =>  'GC',
 169                                       -verbose => $verbosity,
 170                                       -qual => '0 0',
 171                                      );
 172 $swq2 = Bio::Seq::SeqWithQuality->new(-seq =>  'GT',
 173                                       -verbose => $verbosity,
 174                                       -qual => '65 0',
 175                                      );
 176 is $swq1->length, $swq2->length;