this repo has no description
1module Lib
2 ( diskFromKey
3 , countOnBits
4 , countRegions
5 ) where
6
7import KnotHash
8import Data.List
9import Data.Char
10import Numeric (showIntAtBase)
11
12diskFromKey :: String -> [String]
13diskFromKey key = [ diskRow key x | x <- [0..127] ]
14
15countOnBits :: [String] -> Int
16countOnBits = length . filter (== '1') . concat
17
18diskRow :: String -> Int -> String
19diskRow key x = hashToBin hash
20 where hash = knotHash (key ++ "-" ++ show x)
21
22hashToBin :: String -> String
23hashToBin = foldl' (\b c -> b ++ hexDigitToBin c) ""
24
25hexDigitToBin :: Char -> String
26hexDigitToBin = intToBinary . digitToInt
27
28intToBinary :: Int -> String
29intToBinary n =
30 let base = showIntAtBase 2 ("01" !!) n ""
31 in (replicate (4 - length base) '0') ++ base
32
33coords :: [(Int, Int)]
34coords = [ (x, y) | x <- [0..127], y <- [0..127] ]
35
36countRegions :: [String] -> Int
37countRegions disk = go 0 $ filter (isOn disk) coords
38 where go :: Int -> [(Int, Int)] -> Int
39 go count [] = count
40 go count (c:cs) = let region = getRegion cs c
41 in go (count + 1) (cs \\ region)
42
43getRegion :: [(Int, Int)] -> (Int, Int) -> [(Int, Int)]
44getRegion coordsToCheck c = go [c] coordsToCheck
45 where go :: [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
46 go region [] = region
47 go region cs = let adjacents = nub . (concatMap $ getAdjacents cs) $ region
48 in if length adjacents > 0
49 then go (region ++ adjacents) (cs \\ adjacents)
50 else region
51
52getAdjacents :: [(Int, Int)] -> (Int, Int) -> [(Int, Int)]
53getAdjacents list c = list `intersect` adjacentsFor c
54
55adjacentsFor :: (Int, Int) -> [(Int, Int)]
56adjacentsFor (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
57
58isOn :: [String] -> (Int, Int) -> Bool
59isOn d (x, y) = d !! y !! x == '1'