1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
-- |
module Xanthous.Generators.Util
( Cells
, CellM
, randInitialize
, numAliveNeighborsM
, numAliveNeighbors
, cloneMArray
) where
import Xanthous.Prelude
import Data.Array.ST
import Data.Array.Unboxed
import Control.Monad.ST
import Control.Monad.Random
import Data.Monoid
import Xanthous.Util (foldlMapM')
import Xanthous.Data (Dimensions, width, height)
type Cells s = STUArray s (Word, Word) Bool
type CellM g s a = RandT g (ST s) a
randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (Cells s)
randInitialize dims aliveChance = do
res <- lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False
for_ [0..dims ^. width] $ \i ->
for_ [0..dims ^. height] $ \j -> do
val <- (>= aliveChance) <$> getRandomR (0, 1)
lift $ writeArray res (i, j) val
pure res
numAliveNeighborsM
:: forall a i j m
. (MArray a Bool m, Ix (i, j), Integral i, Integral j)
=> a (i, j) Bool
-> (i, j)
-> m Word
numAliveNeighborsM cells (x, y) = do
cellBounds <- getBounds cells
getSum <$> foldlMapM'
(fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds)
neighborPositions
where
boundedGet :: ((i, j), (i, j)) -> (Int, Int) -> m Bool
boundedGet ((minX, minY), (maxX, maxY)) (i, j)
| x <= minX
|| y <= minY
|| x >= maxX
|| y >= maxY
= pure True
| otherwise =
let nx = fromIntegral $ fromIntegral x + i
ny = fromIntegral $ fromIntegral y + j
in readArray cells (nx, ny)
neighborPositions :: [(Int, Int)]
neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)]
numAliveNeighbors
:: forall a i j
. (IArray a Bool, Ix (i, j), Integral i, Integral j)
=> a (i, j) Bool
-> (i, j)
-> Word
numAliveNeighbors cells (x, y) =
let cellBounds = bounds cells
in getSum $ foldMap
(Sum . fromIntegral . fromEnum . boundedGet cellBounds)
neighborPositions
where
boundedGet :: ((i, j), (i, j)) -> (Int, Int) -> Bool
boundedGet ((minX, minY), (maxX, maxY)) (i, j)
| x <= minX
|| y <= minY
|| x >= maxX
|| y >= maxY
= True
| otherwise =
let nx = fromIntegral $ fromIntegral x + i
ny = fromIntegral $ fromIntegral y + j
in cells ! (nx, ny)
neighborPositions :: [(Int, Int)]
neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)]
cloneMArray
:: forall a a' i e m.
( Ix i
, MArray a e m
, MArray a' e m
, IArray UArray e
)
=> a i e
-> m (a' i e)
cloneMArray = thaw @_ @UArray <=< freeze
|
