extra/benchmark/knucleotide/knucleotide.factor

   1 USING: kernel io io.files splitting strings io.encodings.ascii
   2        hashtables sequences assocs math namespaces prettyprint
   3        math.parser combinators arrays sorting unicode.case ;
   4
   5 IN: benchmark.knucleotide
   6
   7 : float>string ( float places -- string )
   8     swap >float number>string
   9     "." split1 rot
  10     over length over <
  11     [ CHAR: 0 pad-tail ]
  12     [ head ] if "." glue ;
  13
  14 : discard-lines ( -- )
  15     readln
  16     [ ">THREE" head? [ discard-lines ] unless ] when* ;
  17
  18 : read-input ( -- input )
  19     discard-lines
  20     ">" read-until drop
  21     CHAR: \n swap remove >upper ;
  22
  23 : tally ( x exemplar -- b )
  24     clone tuck
  25     [
  26       [ [ 1 + ] [ 1 ] if* ] change-at
  27     ] curry each ;
  28
  29 : small-groups ( x n -- b )
  30     swap
  31     [ length swap - 1 + ] 2keep
  32     [ [ over + ] dip subseq ] 2curry map ;
  33
  34 : handle-table ( inputs n -- )
  35     small-groups
  36     [ length ] keep
  37     H{ } tally >alist
  38     sort-values reverse
  39     [
  40       dup first write bl
  41       second 100 * over / 3 float>string print
  42     ] each
  43     drop ;
  44
  45 : handle-n ( inputs x -- )
  46     tuck length
  47     small-groups H{ } tally
  48     at [ 0 ] unless*
  49     number>string 8 CHAR: \s pad-tail write ;
  50
  51 : process-input ( input -- )
  52     dup 1 handle-table nl
  53     dup 2 handle-table nl
  54     { "GGT" "GGTA" "GGTATT" "GGTATTTTAATT" "GGTATTTTAATTTATAGT" }
  55     [ [ dupd handle-n ] keep print ] each
  56     drop ;
  57
  58 : knucleotide ( -- )
  59     "resource:extra/benchmark/knucleotide/knucleotide-input.txt"
  60     ascii [ read-input ] with-file-reader
  61     process-input ;
  62
  63 MAIN: knucleotide