examples/tools/seq_pattern.pl

   1 #!/usr/bin/env perl
   2
   3 #-----------------------------------------------------------------------------
   4 # PROGRAM : seq_pattern.pl
   5 # PURPOSE : This is a simple driver used to test the Bio::Tools::SeqPattern.pm
   6 #           module for working with sequence patterns (regexps that recognize
   7 #           nucleotide or peptide sequences).
   8 # AUTHOR  : Steve Chervitz (sac@bioperl.org)
   9 # CREATED : 28 Aug 1997
  10 # USAGE   : seq_pattern.pl -h
  11 # COMMENTS:
  12 #    This is a driver script for the Bio::Tools::SeqPattern.pm Bioperl module
  13 #    that can be used for working with both nucleotide and peptide sequence and
  14 #    offers features such as:
  15 #
  16 #      -- generate reverse complement of sequence pattern
  17 #      -- ensuring pattern has no invalid characters
  18 #      -- untainting pattern
  19 #      -- expanding ambiguity codes.
  20 #
  21 #     Functionality is not yet complete but it may be of use as-is.
  22 #
  23 # DOCUMENTATION:
  24 #  http://genome-www.stanford.edu/perlOOP/bioperl/lib/Bio/Tools/SeqPattern.pm.html
  25 #
  26 #-----------------------------------------------------------------------------
  27
  28 use Bio::Tools::SeqPattern ();
  29 use Getopt::Std;
  30
  31 $opt_h = 0;
  32 $opt_n = 0;
  33 $opt_p = 0;
  34 $opt_r = 0;
  35
  36 getopts('hnprv:');
  37 $pat = $ARGV[0] || '';
  38
  39 $opt_h and die <<"QQ_USAGE_QQ";
  40
  41 Usage: seq_pattern.pl [-n|p|r|h] 'REGEXP'
  42
  43  regexp : full-regular expression for a nucleotide or peptide sequence.
  44           Must be listed *after* one of the following options:
  45  -n     : interpret regexp as a nucleotide pattern.
  46  -p     : interpret regexp as a peptide pattern.
  47  -r     : output only the reverse complement of the nucleotide pattern.
  48  -h     : print usage.
  49
  50 QQ_USAGE_QQ
  51
  52
  53 ## Nucleotide test patterns (most are based on actual patterns submitted by users):
  54
  55 %nucpat = (1 =>'YR...CG(CCG){5,7}CG[^G]TN{10,}[SA]{4}NN(ACA){2,}GCGTTT.{20,40}GT>',
  56            2 =>'cggnnn[ta][ta][ta]n{3,5}[ta][ta][ta]nnnccg',
  57            3 =>'<ATGX{6,10}RTTRTT',
  58            4 =>'cggnnnwwwn{3,5}wwwnnnccg',
  59            5 =>'(CCCCT)N{1,200}(agggg)N{1,200}(agggg)',
  60            6 =>'cccct{2,}',
  61            7 =>'(a){10,40}',
  62            8 =>'(cag){36,}',
  63            9 =>'rgaatgx{2,}ygtttca(cag){5,}',
  64            10 =>'yattgtt(n){20,80}yattgtt',
  65            11 =>'yattgtt(aca){20,80}yattgtt',
  66            12 =>'TATAAAN{30,100}[AT][CAT][AT]YCAAR[CAT][AT][CAT]',
  67            13 =>'TGACTC[N]{1,300}TGACTC',
  68            14 =>'TGACTCN*GAGTCAN*GAGTCAN*TGACTC',
  69            15 =>'TGACTC(TCA)*GAGTCA',
  70            16 =>'TGACTCN*GAG(TCA)*GAGTCA',
  71            17 =>'[at][at]ttcacatgy',
  72            );
  73
  74 %peppat = (1 =>'<X{10,}[WFY]XXXDN[BK][ST]Z{5,}>',
  75            2 =>'<x{10,40}[gas]x[gasct]x*[gascdn]x[gas]x{0,10}[bst]{8,}x{0,8}>',
  76            );
  77
  78 #----------------------
  79 # Main
  80
  81 if($opt_r) {
  82     print Bio::Tools::SeqPattern->new(-SEQ =>$pat, -TYPE =>'Dna')->revcom->str,"\n";
  83
  84 } else {
  85     test_nuc($pat) if ($opt_n and !$opt_p);
  86     test_pep($pat) if ($opt_p and !$opt_n);
  87     (test_nuc($pat), test_pep($pat)) if !($opt_p or $opt_n);
  88 }
  89
  90 exit 0;
  91
  92 #----------------------
  93
  94 sub test_nuc {
  95 # Create nucleotide pattern object:
  96     my $pat = shift;
  97     $pat ||= $nucpat{9};
  98
  99     $npat = new Bio::Tools::SeqPattern(-seq =>$pat, -type =>'Dna');
 100
 101     print "\nNucleotide Pattern:\n";
 102     print "-----------------------\n";
 103     printf "%18s: %s\n", 'Type',    $npat->type;
 104     printf "%18s: %s\n", 'Original',$npat->str;
 105     printf "%18s: %s\n", 'Expanded', $npat->expand;
 106     printf "%18s: %s\n", 'Reverse-Comp', $npat->revcom->str;
 107     printf "%18s: %s\n", 'Rev-Comp+Expanded', $npat->revcom(1)->str; # Hate this syntax. May change.
 108     print "\n";
 109 }
 110
 111
 112 sub test_pep {
 113 # Create peptide pattern object:
 114     my $pat = shift;
 115     $pat ||= $peppat{1};
 116
 117     $ppat = new Bio::Tools::SeqPattern(-seq =>$pat, -type =>'Amino');
 118
 119     print "\nPeptide Pattern:\n";
 120     print "-----------------------\n";
 121     printf "%18s: %s\n", 'Type',    $ppat->type;
 122     printf "%18s: %s\n", 'Original',$ppat->str;
 123     printf "%18s: %s\n", 'Expanded', $ppat->expand;
 124     print "\n";
 125 }