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