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