extra/benchmark/regex-dna/regex-dna.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors regexp prettyprint io io.encodings.ascii
   4 io.files kernel sequences assocs namespaces ;
   5 IN: benchmark.regex-dna
   6
   7 ! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=regexdna&lang=ruby&id=1
   8
   9 : strip-line-breaks ( string -- string' )
  10     R/ >.*\n|\n/ "" re-replace ;
  11
  12 : count-patterns ( string -- )
  13     {
  14         R/ agggtaaa|tttaccct/i
  15         R/ [cgt]gggtaaa|tttaccc[acg]/i
  16         R/ a[act]ggtaaa|tttacc[agt]t/i
  17         R/ ag[act]gtaaa|tttac[agt]ct/i
  18         R/ agg[act]taaa|ttta[agt]cct/i
  19         R/ aggg[acg]aaa|ttt[cgt]ccct/i
  20         R/ agggt[cgt]aa|tt[acg]accct/i
  21         R/ agggta[cgt]a|t[acg]taccct/i
  22         R/ agggtaa[cgt]|[acg]ttaccct/i
  23     } [
  24         [ raw>> write bl ]
  25         [ count-matches . ]
  26         bi
  27     ] with each ;
  28
  29 : do-replacements ( string -- string' )
  30     {
  31         { R/ B/ "(c|g|t)" }
  32         { R/ D/ "(a|g|t)" }
  33         { R/ H/ "(a|c|t)" }
  34         { R/ K/ "(g|t)" }
  35         { R/ M/ "(a|c)" }
  36         { R/ N/ "(a|c|g|t)" }
  37         { R/ R/ "(a|g)" }
  38         { R/ S/ "(c|t)" }
  39         { R/ V/ "(a|c|g)" }
  40         { R/ W/ "(a|t)" }
  41         { R/ Y/ "(c|t)" }
  42     } [ re-replace ] assoc-each ;
  43
  44 SYMBOL: ilen
  45 SYMBOL: clen
  46
  47 : regex-dna ( file -- )
  48     ascii file-contents dup length ilen set
  49     strip-line-breaks dup length clen set
  50     dup count-patterns
  51     do-replacements
  52     nl
  53     ilen get .
  54     clen get .
  55     length . ;
  56
  57 : regex-dna-main ( -- )
  58     "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" regex-dna ;
  59
  60 MAIN: regex-dna-main