factor: trim using lists

[factor.git] / extra / benchmark / fasta / fasta.factor

diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor
index 226287974f836d528e2e2a3643c609748f885d21..c36d67c932f1744b49e564724332ef9ce86dbb91 100644 (file)
--- a/extra/benchmark/fasta/fasta.factor
+++ b/extra/benchmark/fasta/fasta.factor
@@ -1,6 +1,6 @@
 ! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
-USING: assocs benchmark.reverse-complement byte-arrays fry io
-io.encodings.ascii io.files locals kernel math sequences
+USING: alien.data assocs benchmark.reverse-complement
+byte-arrays io io.encodings.ascii io.files kernel math sequences
 sequences.private specialized-arrays strings typed ;
 QUALIFIED-WITH: alien.c-types c
 SPECIALIZED-ARRAY: c:double
@@ -12,8 +12,8 @@ CONSTANT: IC 29573
 CONSTANT: initial-seed 42
 CONSTANT: line-length 60
 
-: random ( seed -- seed n )
-    >float IA * IC + IM mod dup IM /f ; inline
+: next-fasta-random ( seed -- seed n )
+    IA * IC + IM mod dup IM /f ; inline
 
 CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
 
@@ -47,29 +47,29 @@ CONSTANT: homo-sapiens
 
 TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array )
     [ keys >byte-array ]
-    [ values >double-array unclip [ + ] accumulate swap suffix ] bi ;
+    [ values c:double >c-array 0.0 [ + ] accumulate* ] bi ;
 
 :: select-random ( seed chars floats -- seed elt )
-    seed random floats [ <= ] with find drop chars nth-unsafe ; inline
+    seed next-fasta-random floats [ <= ] with find drop chars nth-unsafe ; inline
 
-TYPED: make-random-fasta ( seed: fixnum len: fixnum chars: byte-array floats: double-array -- seed: fixnum )
+TYPED: make-random-fasta ( seed: float len: fixnum chars: byte-array floats: double-array -- seed: float )
     '[ _ _ select-random ] "" replicate-as print ;
 
 : write-description ( desc id -- )
     ">" write write bl print ;
 
-:: split-lines ( n quot -- )
+:: n-split-lines ( n quot -- )
     n line-length /mod
     [ [ line-length quot call ] times ] dip
     quot unless-zero ; inline
 
-TYPED: write-random-fasta ( seed: fixnum n: fixnum chars: byte-array floats: double-array desc id -- seed: fixnum )
+TYPED: write-random-fasta ( seed: float n: fixnum chars: byte-array floats: double-array desc id -- seed: float )
     write-description
-    '[ _ _ make-random-fasta ] split-lines ;
+    '[ _ _ make-random-fasta ] n-split-lines ;
 
 TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum )
     alu length :> kn
-    len iota [ k + kn mod alu nth-unsafe ] "" map-as print
+    len <iota> [ k + kn mod alu nth-unsafe ] "" map-as print
     k len + ;
 
 : write-repeat-fasta ( n alu desc id -- )
@@ -77,7 +77,7 @@ TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum )
     [let
         :> alu
         0 :> k!
-        [| len | k len alu make-repeat-fasta k! ] split-lines
+        [| len | k len alu make-repeat-fasta k! ] n-split-lines
     ] ;
 
 : fasta ( n out -- )
@@ -91,14 +91,17 @@ TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum )
             n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta
 
             initial-seed
+
             n 3 * homo-sapiens-chars homo-sapiens-floats
             "IUB ambiguity codes" "TWO" write-random-fasta
+
             n 5 * IUB-chars IUB-floats
             "Homo sapiens frequency" "THREE" write-random-fasta
+
             drop
         ] with-file-writer
     ] ;
 
-: run-fasta ( -- ) 2500000 reverse-complement-in fasta ;
+: fasta-benchmark ( -- ) 2500000 reverse-complement-in fasta ;
 
-MAIN: run-fasta
+MAIN: fasta-benchmark