! 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
-sequences.private specialized-arrays strings typed alien.data ;
+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
IN: benchmark.fasta
CONSTANT: initial-seed 42
CONSTANT: line-length 60
-: random ( seed -- seed n )
+: next-fasta-random ( seed -- seed n )
IA * IC + IM mod dup IM /f ; inline
CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array )
[ keys >byte-array ]
- [ values c:double >c-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: 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: 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 -- )
[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 -- )
] with-file-writer
] ;
-: run-fasta ( -- ) 2500000 reverse-complement-in fasta ;
+: fasta-benchmark ( -- ) 2500000 reverse-complement-in fasta ;
-MAIN: run-fasta
+MAIN: fasta-benchmark