t/Tools/IUPAC.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 => 46);
  11
  12     use_ok('Bio::Tools::IUPAC');
  13     use_ok('Bio::Seq');
  14     use_ok('Bio::PrimarySeq');
  15 }
  16
  17
  18 # IUPAC sequences and regular expressions
  19
  20 my $ambiseq = Bio::Seq->new(
  21     -seq      => 'ARTCGTTGN',
  22     -alphabet => 'dna',
  23 );
  24
  25 my $ambiprimaryseq = Bio::Seq->new(
  26     -seq      => 'ARTCGTTGN',
  27     -alphabet => 'dna',
  28 );
  29
  30 ok my $iupac = Bio::Tools::IUPAC->new( -seq => $ambiprimaryseq );
  31
  32 ok $iupac = Bio::Tools::IUPAC->new( -seq => $ambiseq );
  33
  34 ok my $regexp = $iupac->regexp, 'Regexp';
  35 is $regexp, 'A[AGR]TCGTTG[ACGTBDHKMNRSVWY]';
  36
  37 $regexp = $iupac->regexp(1);
  38 is $regexp, 'A[AGR][TU]CG[TU][TU]G[ACGTUBDHKMNRSVWY]', 'Regexp';
  39
  40
  41 is $iupac->count(), 8, 'Count';
  42
  43 my @seqs;
  44 while (my $uniqueseq = $iupac->next_seq()) {
  45     push @seqs, $uniqueseq->seq;
  46     is $uniqueseq->isa('Bio::PrimarySeqI'), 1;
  47     like $uniqueseq->seq, qr/$regexp/i;
  48 }
  49
  50 @seqs = sort @seqs;
  51 is_deeply \@seqs, [ 'AATCGTTGA', 'AATCGTTGC', 'AATCGTTGG', 'AATCGTTGT',
  52                     'AGTCGTTGA', 'AGTCGTTGC', 'AGTCGTTGG', 'AGTCGTTGT' ];
  53
  54 like $ambiseq->seq, qr/$regexp/i, 'Regexp matches ambiguous sequences';
  55 like 'ARTCGTTGW', qr/$regexp/i;
  56
  57
  58 # IUPAC code methods
  59
  60 my %iupac;
  61 ok %iupac = $iupac->iupac_iub(), 'Nucleic IUPAC';
  62 ok exists $iupac{'A'};
  63 ok not exists $iupac{'Z'};
  64
  65 ok %iupac = $iupac->iupac_iub_amb();
  66 ok exists $iupac{'N'};
  67 ok not exists $iupac{'A'};
  68
  69 ok %iupac = $iupac->iupac_rev_iub();
  70
  71 ok %iupac = $iupac->iupac_iup(), 'Proteic IUPAC';
  72 ok exists $iupac{'A'};
  73 ok exists $iupac{'Z'};
  74
  75 ok %iupac = $iupac->iupac_iup_amb();
  76 ok exists $iupac{'B'};
  77 ok not exists $iupac{'A'};
  78
  79 ok %iupac = $iupac->iupac();
  80 ok not(exists $iupac{'Z'});
  81
  82 ok %iupac = $iupac->iupac_amb();
  83 ok not(exists $iupac{'A'});
  84
  85 ok %iupac = Bio::Tools::IUPAC->new->iupac_iup;
  86