@@ -1,7 +1,6 @@
3import System
3import System
6alu : String
5alu : String
7alu = "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGG\
6alu = "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGG\
@@ -9,12 +8,12 @@ alu = "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGG\
9 \CGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGC\
8 \CGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGC\
10 \GGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
9 \GGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
12−iub : List (Char, Float)
11+iub : List (Char, Double)
13iub = [('a',0.27),('c',0.12),('g',0.12),('t',0.27),('B',0.02)
12iub = [('a',0.27),('c',0.12),('g',0.12),('t',0.27),('B',0.02)
14 ,('D',0.02),('H',0.02),('K',0.02),('M',0.02),('N',0.02)
13 ,('D',0.02),('H',0.02),('K',0.02),('M',0.02),('N',0.02)
15 ,('R',0.02),('S',0.02),('V',0.02),('W',0.02),('Y',0.02)]
14 ,('R',0.02),('S',0.02),('V',0.02),('W',0.02),('Y',0.02)]
17−homosapiens : List (Char, Float)
16+homosapiens : List (Char, Double)
18homosapiens = [('a',0.3029549426680),('c',0.1979883004921)
17homosapiens = [('a',0.3029549426680),('c',0.1979883004921)
19 ,('g',0.1975473066391),('t',0.3015094502008)]
18 ,('g',0.1975473066391),('t',0.3015094502008)]
@@ -30,10 +29,10 @@ splitAt' : Nat -> String -> (String, String)
30splitAt' n s = let s' = unpack s in (pack $ take n s', pack $ drop n s')
29splitAt' n s = let s' = unpack s in (pack $ take n s', pack $ drop n s')
32writeAlu : String -> String -> IO ()
31writeAlu : String -> String -> IO ()
33−writeAlu name s0 = putStrLn name $> go s0
32+writeAlu name s0 = putStrLn name *> go s0
35 go "" = return ()
34 go "" = return ()
36− go s = let (h,t) = splitAt' 60 s in putStrLn h $> go t
35+ go s = let (h,t) = splitAt' 60 s in putStrLn h *> go t
38replicate : Int -> Char -> String
37replicate : Int -> Char -> String
39replicate 0 c = ""
38replicate 0 c = ""
@@ -44,10 +43,10 @@ scanl f q ls = q :: (case ls of
45 x::xs => scanl f (f q x) xs)
44 x::xs => scanl f (f q x) xs)
47−accum : (Char,Float) -> (Char,Float) -> (Char,Float)
46+accum : (Char,Double) -> (Char,Double) -> (Char,Double)
48accum (_,p) (c,q) = (c,p+q)
47accum (_,p) (c,q) = (c,p+q)
50−make : String -> Int -> List (Char, Float) -> Int -> IO Int
49+make : String -> Int -> List (Char, Double) -> Int -> IO Int
51make name n0 tbl seed0 = do
50make name n0 tbl seed0 = do
52 putStrLn name
51 putStrLn name
53 make' n0 0 seed0 ""
52 make' n0 0 seed0 ""
@@ -55,7 +54,7 @@ make name n0 tbl seed0 = do
55 modulus : Int
54 modulus : Int
56 modulus = 139968
55 modulus = 139968
58− fill : List (Char,Float) -> Int -> List String
57+ fill : List (Char,Double) -> Int -> List String
59 fill ((c,p) :: cps) j =
58 fill ((c,p) :: cps) j =
60 let k = min modulus (cast (cast modulus * p + 1))
59 let k = min modulus (cast (cast modulus * p + 1))
61 in replicate (k - j) c :: fill cps k
60 in replicate (k - j) c :: fill cps k
@@ -65,13 +64,13 @@ make name n0 tbl seed0 = do
65 lookupTable = Foldable.concat (fill (scanl accum ('a',0) tbl) 0)
64 lookupTable = Foldable.concat (fill (scanl accum ('a',0) tbl) 0)
67 make' : Int -> Int -> Int -> String -> IO Int
66 make' : Int -> Int -> Int -> String -> IO Int
68− make' 0 col seed buf = when (col > 0) (putStrLn buf) $> return seed
67+ make' 0 col seed buf = when (col > 0) (putStrLn buf) *> return seed
69 make' n col seed buf = do
68 make' n col seed buf = do
70 let newseed = modInt (seed * 3877 + 29573) modulus
69 let newseed = modInt (seed * 3877 + 29573) modulus
71 let nextchar = strIndex lookupTable newseed
70 let nextchar = strIndex lookupTable newseed
72 let newbuf = buf <+> singleton nextchar
71 let newbuf = buf <+> singleton nextchar
73 if col+1 >= 60
72 if col+1 >= 60
74− then putStrLn newbuf $> make' (n-1) 0 newseed ""
73+ then putStrLn newbuf *> make' (n-1) 0 newseed ""
75 else make' (n-1) (col+1) newseed newbuf
74 else make' (n-1) (col+1) newseed newbuf