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