examples/shootout/regexdna.pir

   1 # Copyright (C) 2006-2009, Parrot Foundation.
   2 # $Id$
   3
   4 .sub main :main
   5         load_bytecode "PGE.pbc"
   6         .local pmc p6rule_compile, rulesub, match, variants, variants_p5, iub, it, matches, capt
   7         .local string pattern, chunk, seq, key, replacement
   8         .local int readlen, chunklen, seqlen, finallen, i, varnum, count
   9         p6rule_compile = compreg "PGE::Perl6Regex"
  10
  11         # Store the regexes we need...
  12         variants = new 'FixedStringArray'
  13         variants = 9
  14         variants[0] = '      agggtaaa|tttaccct      '
  15         variants[1] = '<[cgt]>gggtaaa|tttaccc<[acg]>'
  16         variants[2] = 'a<[act]>ggtaaa|tttacc<[agt]>t'
  17         variants[3] = 'ag<[act]>gtaaa|tttac<[agt]>ct'
  18         variants[4] = 'agg<[act]>taaa|ttta<[agt]>cct'
  19         variants[5] = 'aggg<[acg]>aaa|ttt<[cgt]>ccct'
  20         variants[6] = 'agggt<[cgt]>aa|tt<[acg]>accct'
  21         variants[7] = 'agggta<[cgt]>a|t<[acg]>taccct'
  22         variants[8] = 'agggtaa<[cgt]>|<[acg]>ttaccct'
  23         # and store the p5regex style for printing
  24         variants_p5 = new 'Hash'
  25         variants_p5['      agggtaaa|tttaccct      '] = 'agggtaaa|tttaccct'
  26         variants_p5['<[cgt]>gggtaaa|tttaccc<[acg]>'] = '[cgt]gggtaaa|tttaccc[acg]'
  27         variants_p5['a<[act]>ggtaaa|tttacc<[agt]>t'] = 'a[act]ggtaaa|tttacc[agt]t'
  28         variants_p5['ag<[act]>gtaaa|tttac<[agt]>ct'] = 'ag[act]gtaaa|tttac[agt]ct'
  29         variants_p5['agg<[act]>taaa|ttta<[agt]>cct'] = 'agg[act]taaa|ttta[agt]cct'
  30         variants_p5['aggg<[acg]>aaa|ttt<[cgt]>ccct'] = 'aggg[acg]aaa|ttt[cgt]ccct'
  31         variants_p5['agggt<[cgt]>aa|tt<[acg]>accct'] = 'agggt[cgt]aa|tt[acg]accct'
  32         variants_p5['agggta<[cgt]>a|t<[acg]>taccct'] = 'agggta[cgt]a|t[acg]taccct'
  33         variants_p5['agggtaa<[cgt]>|<[acg]>ttaccct'] = 'agggtaa[cgt]|[acg]ttaccct'
  34
  35         iub = new 'Hash'
  36         iub['b'] = '(c|g|t)'
  37         iub['d'] = '(a|g|t)'
  38         iub['h'] = '(a|c|t)'
  39         iub['k'] = '(g|t)'
  40         iub['m'] = '(a|c)'
  41         iub['n'] = '(a|c|g|t)'
  42         iub['r'] = '(a|g)'
  43         iub['s'] = '(c|g)'
  44         iub['v'] = '(a|c|g)'
  45         iub['w'] = '(a|t)'
  46         iub['y'] = '(c|t)'
  47 # seems faster with the other method...
  48 # and this was the only regex I could get to work
  49 #       iub['[ <-[b]>*: (b) ]*'] = '(c|g|t)'
  50 #       iub['[ <-[d]>*: (d) ]*'] = '(a|g|t)'
  51 #       iub['[ <-[h]>*: (h) ]*'] = '(a|c|t)'
  52 #       iub['[ <-[k]>*: (k) ]*'] = '(g|t)'
  53 #       iub['[ <-[m]>*: (m) ]*'] = '(a|c)'
  54 #       iub['[ <-[n]>*: (n) ]*'] = '(a|c|g|t)'
  55 #       iub['[ <-[r]>*: (r) ]*'] = '(a|g)'
  56 #       iub['[ <-[s]>*: (s) ]*'] = '(c|g)'
  57 #       iub['[ <-[v]>*: (v) ]*'] = '(a|c|g)'
  58 #       iub['[ <-[w]>*: (w) ]*'] = '(a|t)'
  59 #       iub['[ <-[y]>*: (y) ]*'] = '(c|t)'
  60
  61         ############################################
  62         # Read in the file
  63 beginwhile:
  64         chunk = read 65535
  65         chunklen = length chunk
  66         unless chunklen goto endwhile
  67         # They don't say you have to match case insenitive...
  68         downcase chunk
  69         seq .= chunk
  70         goto beginwhile
  71 endwhile:
  72         readlen = length seq
  73
  74         #############################################
  75         # Remove all junk
  76         pattern = '[ ( [ \> \N*: ] )  | \N*:(\n) ]*'
  77         rulesub = p6rule_compile(pattern)
  78         match = rulesub(seq)
  79
  80         capt = match[0]
  81 stripfind:
  82         unless capt goto endstripfind
  83         $P0 = pop capt
  84         $I0 = $P0."from"()
  85         $I1 = $P0."to"()
  86         $I1 -= $I0
  87         substr seq, $I0, $I1, ''
  88         goto stripfind
  89 endstripfind:
  90         seqlen = length seq
  91
  92         ###########################################
  93         # Count the matches
  94         varnum = elements variants
  95         i = 0
  96 beginfor:
  97         count = 0
  98         unless i < varnum goto endfor
  99
 100         pattern = variants[i]
 101         # The spec says to print the p5 style regex, shame on them
 102         $S0 = variants_p5[pattern]
 103         print $S0
 104         print " "
 105         # And out of spite, use p6 rules anyway
 106         rulesub = p6rule_compile(pattern)
 107         match = rulesub(seq)
 108
 109 match_loop:
 110         unless match goto next
 111         inc count
 112         match."next"()
 113         goto match_loop
 114 next:
 115         inc i
 116         print count
 117         print "\n"
 118         goto beginfor
 119 endfor:
 120
 121         #####################################################
 122         # Final replace to make the sequence a p5 style regex
 123         .include "iterator.pasm"
 124         it = iter iub
 125         set it, .ITERATE_FROM_START
 126         matches = new 'ResizablePMCArray'
 127 iter_loop:
 128         unless it goto iter_end
 129         key = shift it
 130         replacement = iub[key]
 131         # Ok, using a regex to match a single fixed character is probably excessive
 132         # But it's what's wanted...
 133         rulesub = p6rule_compile(key)
 134         match = rulesub(seq)
 135
 136 #       capt = match[0]
 137 #switchfind:
 138 #       unless capt goto endswitchfind
 139 #       $P0 = pop capt
 140 #       $I0 = $P0."from"()
 141 #       $I1 = $P0."to"()
 142 #       $I1 -= $I0
 143 #       substr seq, $I0, $I1, replacement
 144 #       goto switchfind
 145 #endswitchfind:
 146
 147 ##########################################
 148 switch:
 149         unless match goto endswitch
 150         $I0 = match."from"()
 151         $I1 = match."to"()
 152         $I1 -= $I0
 153         $P0 = new 'FixedIntegerArray'
 154         $P0 = 2
 155         $P0[0] = $I0
 156         $P0[1] = $I1
 157         push matches, $P0
 158         match."next"()
 159         goto switch
 160 endswitch:
 161
 162 switchloop:
 163         unless matches goto endswitchloop
 164         $P0 = pop matches
 165         $I0 = $P0[0]
 166         $I1 = $P0[1]
 167         substr seq, $I0, $I1, replacement
 168         goto switchloop
 169 endswitchloop:
 170 #############################################
 171         goto iter_loop
 172 iter_end:
 173         finallen = length seq
 174
 175         print "\n"
 176         print readlen
 177         print "\n"
 178         print seqlen
 179         print "\n"
 180         print finallen
 181         print "\n"
 182 .end
 183
 184 # Local Variables:
 185 #   mode: pir
 186 #   fill-column: 100
 187 # End:
 188 # vim: expandtab shiftwidth=4 ft=pir: