source code
// The Computer Language Benchmarks Game
// http://benchmarksgame.alioth.debian.org/
// - Valentin Kraevskiy: initial implementation
// - Peter Kese: parallelization & optimizations, May 2017
open System.IO
open System.Net
open System.Threading.Tasks
let im, ia, ic = 139968, 3877, 29573
let inline nextRand seed = (seed * ia + ic) % im
let alu =
"GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG\
GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA\
CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT\
ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA\
GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG\
AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC\
AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"B
let makeRevIntCumulative =
let randRange p = int (p * float im)
List.fold (fun (cp, res) (c, p) ->
cp + p, (c, cp + p) :: res) (0.0, [])
>> snd
>> List.map (fun (c,p) -> c,randRange p) >> List.toArray
let homoSapiens =
makeRevIntCumulative
['a'B, 0.3029549426680
'c'B, 0.1979883004921
'g'B, 0.1975473066391
't'B, 0.3015094502008]
let iub =
makeRevIntCumulative
['a'B, 0.27; 'c'B, 0.12; 'g'B, 0.12
't'B, 0.27; 'B'B, 0.02; 'D'B, 0.02
'H'B, 0.02; 'K'B, 0.02; 'M'B, 0.02
'N'B, 0.02; 'R'B, 0.02; 'S'B, 0.02
'V'B, 0.02; 'W'B, 0.02; 'Y'B, 0.02]
let inline selectRandomIub seed =
let r = nextRand seed
let p n = snd iub.[n]
let rec bisect min max =
let narrowDown split =
match p split with
| x when r <= x -> bisect split max
| _ -> bisect min split
match max-min with
| 1 -> min
| _ -> narrowDown ((min+max)/2)
r, fst iub.[ bisect 0 iub.Length ]
let inline selectRandomHomoSapiens seed =
let r = nextRand seed
let h = homoSapiens
let p n = snd h.[n]
r, fst h.[if r > p 2
then (if r > p 1 then 0 else 1)
else (if r > p 3 then 2 else 3)]
let width = 60
let randomFasta select offset size write =
let mutable seed = 42
for i in 1 .. offset do seed <- nextRand seed
for i in 1 .. size do
let seed2, b = select seed
seed <- seed2
write b
if i % width = 0 then write '\n'B
if size % width <> 0 then write '\n'B
let repeatFasta (table : byte []) size write =
for i in 1 .. size do
write <| table.[(i - 1) % table.Length]
if i % width = 0 then write '\n'B
if size % width <> 0 then write '\n'B
let toAsync (taskFn, size, desc) = async {
let ms = new MemoryStream(size + size/width + 100)
let write = ms.WriteByte
Array.iter write desc
taskFn size write
ms.Position <- int64 0
return ms}
[<EntryPoint>]
let main args =
let n = try int args.[0] with _ -> 1000
let stdout = System.Console.OpenStandardOutput ()
let stdoutFolder prevComplete (msTask:Task<MemoryStream>) = async {
let! _ = prevComplete
let! ms = msTask |> Async.AwaitTask
ms.CopyTo stdout
}
[ (repeatFasta alu), 2*n, ">ONE Homo sapiens alu\n"B;
(randomFasta selectRandomIub 0), 3*n, ">TWO IUB ambiguity codes\n"B;
(randomFasta selectRandomHomoSapiens (3*n)), 5*n, ">THREE Homo sapiens frequency\n"B]
|> List.map (toAsync >> Async.StartAsTask)
|> List.fold stdoutFolder (async { return () })
|> Async.RunSynchronously
0