t/SeqTools/SeqPattern.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 => 28);
  10
  11         use_ok('Bio::Tools::SeqPattern');
  12 }
  13
  14 my ( $pattern,$pattern_obj,$pattern_obj2, $pattern_obj3);
  15
  16 $pattern     = '(CCCCT)N{1,200}(agyyg)N{1,80}(ag)';
  17 ok $pattern_obj = Bio::Tools::SeqPattern->new(-SEQ =>$pattern, -TYPE =>'dna');
  18 isa_ok $pattern_obj, 'Bio::Tools::SeqPattern';
  19
  20 $pattern_obj2  = $pattern_obj->revcom();
  21 is $pattern_obj2->str, '(CT)N(CRRCT){1,80}N(AGGGG){1,200}';
  22
  23 $pattern_obj3 = $pattern_obj->revcom(1);
  24 is $pattern_obj3->str, '(CT).{1,80}(C[GA][GA]CT).(AGGGG){1,200}';
  25
  26 $pattern     = '(CCCCT)N{1,200}(agyyg)N{1,80}(bb)'; # test protein object expand
  27 ok $pattern_obj = Bio::Tools::SeqPattern->new(-SEQ =>$pattern, -TYPE =>'protein');
  28 isa_ok $pattern_obj, 'Bio::Tools::SeqPattern';
  29
  30 is $pattern_obj2->expand, '(CT).(C[AG][AG]CT){1,80}.(AGGGG){1,200}';
  31
  32 # amino patterns
  33
  34 $pattern = 'ABZH';
  35 $pattern_obj2 = Bio::Tools::SeqPattern->new(-SEQ =>$pattern,
  36                                            -TYPE =>'amino');
  37 is $pattern_obj2->expand, 'A[EQ][DN]H';
  38
  39 SKIP: {
  40     test_skip(-tests => 19, -requires_module => 'List::MoreUtils');
  41     # Test reverse complement
  42     my $rev_pattern = $pattern_obj2->backtranslate;
  43     isa_ok $rev_pattern, 'Bio::Tools::SeqPattern';
  44     is $rev_pattern->str, 'GCNRAYSARCAY';
  45
  46     # Test exceptions.
  47     throws_ok { $pattern_obj2->revcom  } qr/revcom for .+ sequence types/;
  48     throws_ok { $rev_pattern->backtranslate } qr/backtranslate for .+ sequence types/;
  49
  50     # Test reverse translation more thoroughly
  51
  52     my @data;
  53     while (<DATA>) {
  54        chomp;
  55        push @data, [ split ];
  56     }
  57
  58     foreach my $line (@data) {
  59         my $pattern_obj = Bio::Tools::SeqPattern->new(
  60             -SEQ  => $line->[0],
  61             -TYPE => 'amino',
  62         );
  63
  64         isa_ok $pattern_obj, 'Bio::Tools::SeqPattern';
  65
  66         my $backtranslate = $pattern_obj->backtranslate;
  67         isa_ok $backtranslate, 'Bio::Tools::SeqPattern';
  68         is $backtranslate->str, $line->[1],
  69     }
  70 }
  71
  72 __DATA__
  73 MAEELKAVAP ATGGCNGARGARYTNAARGCNGTNGCNCCN
  74 LKGHB[WhYq]Q YTNAARGGNCAYRAYYRNCAR
  75 (LK){2,3}[^GHB][WHYQ]Q (YTNAAR){2,3}HBNYRNCAR
  76 LK[^GHB][WHYQ]Q YTNAARHBNYRNCAR
  77 (LK){2,3}[^GHB][WHYQ]QX.X (YTNAAR){2,3}HBNYRNCARNNNNNNNNN