common/haskell: move conway to common/
This commit is contained in:
parent
0d3100b152
commit
17a0a2e8a4
2 changed files with 29 additions and 18 deletions
|
@ -3,35 +3,18 @@
|
||||||
module Day17 where
|
module Day17 where
|
||||||
|
|
||||||
import AoC
|
import AoC
|
||||||
|
import Conway
|
||||||
|
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Vector.Sized (Vector)
|
import Data.Vector.Sized (Vector)
|
||||||
import qualified Data.Vector.Sized as V
|
import qualified Data.Vector.Sized as V
|
||||||
import Data.Map (Map)
|
|
||||||
import qualified Data.Map as M
|
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
class Index i where
|
|
||||||
neighbours :: i -> [i]
|
|
||||||
addIndex :: i -> i -> i
|
|
||||||
|
|
||||||
instance (Num a, Eq a) => Index (Vector n a) where
|
instance (Num a, Eq a) => Index (Vector n a) where
|
||||||
neighbours i = filter (/= i) . V.mapM (flip map [-1, 0, 1] . (+)) $ i
|
neighbours i = filter (/= i) . V.mapM (flip map [-1, 0, 1] . (+)) $ i
|
||||||
addIndex = V.zipWith (+)
|
addIndex = V.zipWith (+)
|
||||||
|
|
||||||
counts :: Ord a => [a] -> Map a Int
|
|
||||||
counts = M.fromList . map (\xs -> (head xs, length xs)) . group . sort
|
|
||||||
|
|
||||||
neighbourCounts :: (Index i, Ord i) => Set i -> Map i Int
|
|
||||||
neighbourCounts = counts . concatMap neighbours . S.elems
|
|
||||||
|
|
||||||
update :: (Index i, Ord i) => (Int -> Bool) -> (Int -> Bool) -> Set i -> Set i
|
|
||||||
update create destroy old = M.keysSet $ M.filterWithKey shouldLive $ M.fromSet (flip (M.findWithDefault 0) nCounts) indices
|
|
||||||
where nCounts = neighbourCounts old
|
|
||||||
indices = S.union old $ M.keysSet nCounts
|
|
||||||
shouldLive ix n = if S.notMember ix old then create n else not $ destroy n
|
|
||||||
|
|
||||||
run6 :: (Index i, Ord i) => Set i -> Int
|
run6 :: (Index i, Ord i) => Set i -> Int
|
||||||
run6 = S.size . (!! 6) . iterate (update (==3) (`notElem` [2, 3]))
|
run6 = S.size . (!! 6) . iterate (update (==3) (`notElem` [2, 3]))
|
||||||
|
|
||||||
|
|
28
common/Conway.hs
Normal file
28
common/Conway.hs
Normal file
|
@ -0,0 +1,28 @@
|
||||||
|
module Conway
|
||||||
|
( Index(..)
|
||||||
|
, update
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.List
|
||||||
|
import qualified Data.Vector.Sized as V
|
||||||
|
import Data.Map (Map)
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Data.Set (Set)
|
||||||
|
import qualified Data.Set as S
|
||||||
|
|
||||||
|
class Index i where
|
||||||
|
neighbours :: i -> [i]
|
||||||
|
addIndex :: i -> i -> i
|
||||||
|
|
||||||
|
counts :: Ord a => [a] -> Map a Int
|
||||||
|
counts = M.fromList . map (\xs -> (head xs, length xs)) . group . sort
|
||||||
|
|
||||||
|
neighbourCounts :: (Index i, Ord i) => Set i -> Map i Int
|
||||||
|
neighbourCounts = counts . concatMap neighbours . S.elems
|
||||||
|
|
||||||
|
update :: (Index i, Ord i) => (Int -> Bool) -> (Int -> Bool) -> Set i -> Set i
|
||||||
|
update create destroy old = M.keysSet $ M.filterWithKey shouldLive $ M.fromSet (flip (M.findWithDefault 0) nCounts) indices
|
||||||
|
where nCounts = neighbourCounts old
|
||||||
|
indices = S.union old $ M.keysSet nCounts
|
||||||
|
shouldLive ix n = if S.notMember ix old then create n else not $ destroy n
|
Loading…
Reference in a new issue