advent24.hs 2.62 KB
Newer Older
Neil Smith's avatar
Neil Smith committed
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 100
-- import Debug.Trace

import Data.Text (Text)
-- import qualified Data.Text as T
import qualified Data.Text.IO as TIO

import Data.Attoparsec.Text hiding (take)
-- import Data.Attoparsec.Combinator
-- import Control.Applicative
-- import Control.Applicative.Combinators

import qualified Data.Set as S
import Linear (V2(..), (^+^))
-- import Data.Semigroup
-- import Data.Monoid


data Direction = NE | E | SE | SW | W | NW
  deriving (Show, Eq, Enum, Bounded)

type Tile = V2 Int -- x, y
type Grid = S.Set Tile

instance Semigroup Int where
  (<>) = (+)

instance Monoid Int where
  mempty = 0

main :: IO ()
main = 
    do text <- TIO.readFile "data/advent24.txt"
       let walks = successfulParse text
       let grid0 = foldr flipTile S.empty walks
       print $ part1 grid0
       print $ part2 grid0

part1 grid0 = S.size grid0
part2 grid0 = S.size $ (iterate update  grid0) !! 100

delta :: Direction -> Tile
delta NE = V2  1  0
delta E  = V2  0  1
delta SE = V2 -1  1
delta SW = V2 -1  0
delta W  = V2  0 -1
delta NW = V2  1 -1


flipTile :: Tile -> Grid -> Grid
flipTile tile tiles 
  | tile `S.member` tiles = S.delete tile tiles
  | otherwise = S.insert tile tiles


neighbourSpaces :: Tile -> Grid
neighbourSpaces here = S.fromList $ map nbrSpace [minBound .. maxBound] -- [NE .. NW]
  where nbrSpace d = here ^+^ (delta d)

countOccupiedNeighbours :: Tile -> Grid -> Int
countOccupiedNeighbours cell grid = 
  S.size $ S.intersection grid $ neighbourSpaces cell

tileBecomesWhite :: Grid -> Tile -> Bool
tileBecomesWhite grid cell = black && ((nNbrs == 0) || (nNbrs > 2))
  where black = cell `S.member` grid
        nNbrs = countOccupiedNeighbours cell grid

tileBecomesBlack :: Grid -> Tile -> Bool
tileBecomesBlack grid cell = white && (nNbrs == 2)
  where white = cell `S.notMember` grid
        nNbrs = countOccupiedNeighbours cell grid

update :: Grid -> Grid
update grid = (grid `S.union` newBlacks) `S.difference` newWhites
  where neighbours = (S.foldr mergeNeighbours S.empty grid) `S.difference` grid
        mergeNeighbours cell acc = S.union acc $ neighbourSpaces cell
        newWhites = S.filter (tileBecomesWhite grid) grid
        newBlacks = S.filter (tileBecomesBlack grid) neighbours


-- Parse the input file

tilesP = tileP `sepBy` endOfLine
tileP = foldMap delta <$> many1 stepP

stepP = choice [neP, nwP, seP, swP, eP, wP]

neP = "ne" *> pure NE
nwP = "nw" *> pure NW
seP = "se" *> pure SE
swP = "sw" *> pure SW
eP  = "e"  *> pure E
wP  = "w"  *> pure W

-- successfulParse :: Text -> [Tile]
successfulParse input = 
  case parseOnly tilesP input of
    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
    Right tiles -> tiles