46 lines
1.6 KiB
Haskell
46 lines
1.6 KiB
Haskell
{-# OPTIONS_GHC -Wno-x-partial #-}
|
|
|
|
module Day12 (day12_1) where
|
|
|
|
import Data.Foldable (toList)
|
|
import Data.Graph (Tree, Vertex, graphFromEdges, scc)
|
|
import Data.List.Split (chunksOf)
|
|
|
|
type Coords = (Int, Int)
|
|
|
|
type V = (String, Int)
|
|
|
|
getValue :: [[V]] -> Coords -> V
|
|
getValue grid (i, j) = grid !! i !! j
|
|
|
|
getEdges :: [[V]] -> Coords -> [Int]
|
|
getEdges grid (i, j) =
|
|
let value = fst $ grid !! i !! j
|
|
adjI = filter (\x -> fst x >= 0 && fst x < length grid && snd x >= 0 && snd x < length (head grid)) [(i, j + 1), (i + 1, j), (i, j - 1), (i - 1, j)]
|
|
in [snd x | x <- map (getValue grid) adjI, head value == head (fst x)]
|
|
|
|
listVertices :: [String] -> [[V]]
|
|
listVertices grid =
|
|
let l = length $ head grid
|
|
in chunksOf l $ zip (map (: []) (concat grid)) [0 ..]
|
|
|
|
calculatePerimeter :: (Vertex -> (String, Vertex, [Vertex])) -> Tree Vertex -> Int
|
|
calculatePerimeter nodeFromVertex p =
|
|
let edges = concat [x | (_, _, x) <- toList $ fmap nodeFromVertex p]
|
|
area = 4 * length p
|
|
in area - length edges
|
|
|
|
day12_1 :: IO ()
|
|
day12_1 = do
|
|
contents <- lines <$> readFile "input/day12.txt"
|
|
let grid = listVertices contents
|
|
edgeCoords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (head grid) - 1]]
|
|
edgeList = [(x, y, z) | ((x, y), z) <- zip (concat grid) (map (getEdges grid) edgeCoords)]
|
|
(graph, nodeFromVertex, _) = graphFromEdges edgeList
|
|
plots = scc graph
|
|
areas = map length plots
|
|
perimeters = map (calculatePerimeter nodeFromVertex) plots
|
|
putStrLn $
|
|
"Day 12, Puzzle 1 solution: "
|
|
++ show (sum $ zipWith (*) areas perimeters)
|