{-# Language QuasiQuotes, DataKinds, ImportQualifiedPost #-}
{-|
Module      : Main
Description : Day 14 solution
Copyright   : (c) Eric Mertens, 2017
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2017/day/14>

Day 14 ties Day 10 and Day 12 together presumably to see how quickly
we can combine our previous results to make something new.

-}
module Main (main) where

import Advent (format)
import Advent.Coord (cardinal, Coord(..))
import KnotHash (knotHash)
import Data.Vector qualified as V
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Bits (Bits(testBit))
import Data.Graph.Inductive

-- | Compute the solution to Day 14. Input can be overriden via the
-- command-line.
--
-- 8106
-- 1164
main :: IO ()
IO ()
main =
  do [Char]
input <- [format|2017 14 %s%n|]

     let g :: Gr Coord ()
g = Set Coord -> Gr Coord ()
coordsToGraph (Vector Integer -> Set Coord
gridToCoords ([Char] -> Vector Integer
buildGrid [Char]
input))

     Int -> IO ()
forall a. Show a => a -> IO ()
print (Gr Coord () -> Int
forall a b. Gr a b -> Int
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int
noNodes Gr Coord ()
g)
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Gr Coord () -> Int
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int
noComponents Gr Coord ()
g)


-- | Convert the set of coordinates into a graph labeled with those
-- coordinates where adjacent elements have edges between them.
coordsToGraph :: Set Coord -> Gr Coord ()
coordsToGraph :: Set Coord -> Gr Coord ()
coordsToGraph Set Coord
coords = Gr Coord () -> NodeMapM Coord () Gr () -> Gr Coord ()
forall (g :: * -> * -> *) a b r.
(DynGraph g, Ord a) =>
g a b -> NodeMapM a b g r -> g a b
run_ Gr Coord ()
forall a b. Gr a b
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty (NodeMapM Coord () Gr () -> Gr Coord ())
-> NodeMapM Coord () Gr () -> Gr Coord ()
forall a b. (a -> b) -> a -> b
$
  do [LNode Coord]
_ <- [Coord] -> NodeMapM Coord () Gr [LNode Coord]
forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
[a] -> NodeMapM a b g [LNode a]
insMapNodesM (Set Coord -> [Coord]
forall a. Set a -> [a]
Set.toList Set Coord
coords)
     [(Coord, Coord, ())] -> NodeMapM Coord () Gr ()
forall a (g :: * -> * -> *) b.
(Ord a, DynGraph g) =>
[(a, a, b)] -> NodeMapM a b g ()
insMapEdgesM [ (Coord
src,Coord
dst,())
                    | Coord
src <- Set Coord -> [Coord]
forall a. Set a -> [a]
Set.toList Set Coord
coords
                    , Coord
dst <- Coord -> [Coord]
cardinal Coord
src
                    , Coord -> Set Coord -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Coord
dst Set Coord
coords ]

-- | Build the problem grid as a list of rows where a cell is set in
-- a row is set when the bit at that index is set.
buildGrid :: String -> V.Vector Integer
buildGrid :: [Char] -> Vector Integer
buildGrid [Char]
str = Int -> (Int -> Integer) -> Vector Integer
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
128 ((Int -> Integer) -> Vector Integer)
-> (Int -> Integer) -> Vector Integer
forall a b. (a -> b) -> a -> b
$ \Int
i -> [Char] -> Integer
knotHash ([Char] -> Integer) -> [Char] -> Integer
forall a b. (a -> b) -> a -> b
$ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i

-- | Convert a grid into a list of coordinates that are set.
gridToCoords :: V.Vector Integer -> Set Coord
gridToCoords :: Vector Integer -> Set Coord
gridToCoords Vector Integer
grid = [Coord] -> Set Coord
forall a. Ord a => [a] -> Set a
Set.fromList
  [ Int -> Int -> Coord
C Int
r Int
c | (Int
r,Integer
row) <- [Int] -> [Integer] -> [(Int, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Vector Integer -> [Integer]
forall a. Vector a -> [a]
V.toList Vector Integer
grid)
          , Int
c       <- [Int
0..Int
127]
          , Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
row Int
c]