Commit 68817bdb authored by Neil Smith's avatar Neil Smith
Browse files

Done day 20

parent ffd4e09b
......@@ -22,7 +22,6 @@ data Rule = Letter Char
| See Int
deriving (Show, Eq)
type RuleSet = M.IntMap Rule
......
# This YAML file describes your package. Stack will automatically generate a
# Cabal file when you run `stack build`. See the hpack website for help with
# this file: <https://github.com/sol/hpack>.
name: advent20
synopsis: Advent of Code
version: '0.0.1'
default-extensions:
- AllowAmbiguousTypes
- ApplicativeDo
- BangPatterns
- BlockArguments
- DataKinds
- DeriveFoldable
- DeriveFunctor
- DeriveGeneric
- DeriveTraversable
- EmptyCase
- FlexibleContexts
- FlexibleInstances
- FunctionalDependencies
- GADTs
- GeneralizedNewtypeDeriving
- ImplicitParams
- KindSignatures
- LambdaCase
- MonadComprehensions
- MonoLocalBinds
- MultiParamTypeClasses
- MultiWayIf
- NamedFieldPuns
- NegativeLiterals
- NumDecimals
# - OverloadedLists
- OverloadedStrings
- PartialTypeSignatures
- PatternGuards
- PatternSynonyms
- PolyKinds
- RankNTypes
- RecordWildCards
- ScopedTypeVariables
- TemplateHaskell
- TransformListComp
- TupleSections
- TypeApplications
- TypeFamilies
- TypeInType
- TypeOperators
- ViewPatterns
executables:
advent20:
main: advent20.hs
source-dirs: src
dependencies:
- base >= 2 && < 6
- text
- attoparsec
- array
- containers
-- 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.Array.Unboxed as A
import Data.Array.Unboxed ((!))
import qualified Data.Map.Strict as M
import Data.Bool (bool)
import Data.List (delete)
import Control.Monad (guard)
-- import Data.Either (fromRight)
type Coord = (Int, Int)
type Pixels = A.UArray Coord Bool
type Border = A.UArray Int Bool
data Tile = Tile
{ tId :: Integer
, pixels :: Pixels
} deriving (Show, Eq)
type Arrangement = M.Map Coord Tile
main :: IO ()
main =
do text <- TIO.readFile "data/advent20.txt"
let tiles = successfulParse text
let arrangeRMax = (floor $ sqrt @Double $ fromIntegral $ length tiles) - 1
let arrangement = arrangeTiles arrangeRMax tiles
let image = assembleImage arrangeRMax arrangement
seaMonster <- readSeaMonster
print $ part1 arrangeRMax arrangement
print $ part2 seaMonster image
part1 rMax arrangement
= product $ M.elems
$ M.map tId
$ M.filterWithKey (isCorner rMax) arrangement
part2 seaMonster image = minimum $ map (countRoughness seaMonster) transImages
where imgTile = Tile 0 image
transImages = map pixels $ transforms imgTile
readSeaMonster :: IO Pixels
readSeaMonster =
do text <- TIO.readFile "data/advent20seamonster.txt"
-- return $ fromRight (A.listArray ((0, 0), (1, 1)) []) $ parseOnly pixelsP text
return $ case parseOnly pixelsP text of
Left _err -> A.listArray ((0, 0), (1, 1)) []
Right seaMonster -> seaMonster
isCorner _ (0, 0) _ = True
isCorner l (0, c) _ = c == l
isCorner l (r, 0) _ = r == l
isCorner l (r, c) _ = r == l && c == l
arrangeTiles :: Int -> [Tile] -> Arrangement
arrangeTiles rMax tiles = head $ arrange (0, 0) rMax M.empty tiles
arrange :: Coord -> Int -> Arrangement -> [Tile] -> [Arrangement]
-- arrange h _ g ts | trace (show h ++ " " ++ show (M.map tId g) ++ " > " ++ show (length ts)) False = undefined
arrange _ _ grid [] = return grid
arrange (r, c) cMax grid tiles =
do tile <- tiles
transTile <- transforms tile
guard $ if r == 0 then True else matchVertical tileAbove transTile
guard $ if c == 0 then True else matchHorizontal tileLeft transTile
arrange (r', c')
cMax
(M.insert (r, c) transTile grid)
(delete tile tiles)
where tileAbove = grid M.! (r - 1 , c)
tileLeft = grid M.! (r, c - 1)
(r', c') = if c == cMax then (r + 1, 0) else (r, c + 1)
matchHorizontal tile1 tile2 = (rightBorder tile1) == (leftBorder tile2)
matchVertical tile1 tile2 = (bottomBorder tile1) == (topBorder tile2)
topBorder :: Tile -> Border
topBorder Tile{..} = A.listArray (0, c1) [pixels!(0, c) | c <- [0..c1] ]
where (_, (_, c1)) = A.bounds pixels
bottomBorder :: Tile -> Border
bottomBorder Tile{..} = A.listArray (0, c1) [pixels!(r1, c) | c <- [0..c1] ]
where (_, (r1, c1)) = A.bounds pixels
leftBorder :: Tile -> Border
leftBorder Tile{..} = A.listArray (0, r1) [pixels!(r, 0) | r <- [0..r1] ]
where (_, (r1, _)) = A.bounds pixels
rightBorder :: Tile -> Border
rightBorder Tile{..} = A.listArray (0, r1) [pixels!(r, c1) | r <- [0..r1] ]
where (_, (r1, c1)) = A.bounds pixels
transforms :: Tile -> [Tile]
transforms tile =
[ r $ f tile
| r <- [id, tRotate, tRotate . tRotate, tRotate . tRotate . tRotate]
, f <- [id, tFlip]
]
-- rotate quarter turn clockwise
tRotate tile = tile {pixels = pixels'}
where bs = pixels tile
(_, (r1, c1)) = A.bounds bs
pixels' = A.ixmap ((0, 0), (c1, r1)) rotateIndex bs
rotateIndex (r, c) = (r1 - c, r) -- how to get to the old index from the new one
tFlip tile = tile {pixels = pixels'}
where bs = pixels tile
(_, (r1, c1)) = A.bounds bs
pixels' = A.ixmap ((0, 0), (r1, c1)) flipIndex bs
flipIndex (r, c) = (r, c1 - c) -- how to get to the old index from the new one
assembleImage :: Int -> Arrangement -> Pixels
assembleImage arrangeRMax arrangement =
A.array ((0,0), (imageRMax, imageRMax)) imageElements
where (_, (tileRMax, _)) = A.bounds $ pixels $ arrangement M.! (0, 0)
tRM1 = tileRMax - 1
imageRMax = tRM1 * (arrangeRMax + 1) - 1
imageElements =
do ar <- [0..arrangeRMax] -- arrangement row
ac <- [0..arrangeRMax]
tr <- [1..tRM1] -- tile pixels row
tc <- [1..tRM1]
let px = (pixels $ arrangement M.! (ar, ac)) ! (tr, tc)
let ir = (ar * tRM1) + (tr - 1) -- assembled image row
let ic = (ac * tRM1) + (tc - 1)
return ((ir, ic), px)
countRoughness sm image = imPixels - (smPixels * nSeaMonsters)
where smPixels = countPixels sm
imPixels = countPixels image
nSeaMonsters = length $ findSeaMonsters sm image
countPixels :: Pixels -> Int
countPixels = length . filter (== True) . A.elems
findSeaMonsters :: Pixels -> Pixels -> [Coord]
findSeaMonsters sm image = [ (r, c)
| r <- [0..(imR - smR)]
, c <- [0..(imC - smC)]
, seaMonsterPresent sm image r c
]
where (_, (smR, smC)) = A.bounds sm
(_, (imR, imC)) = A.bounds image
seaMonsterPresent sm image dr dc = all bothPresent $ A.indices sm
where bothPresent (r, c) = if (sm!(r, c))
then (image!(r + dr, c + dc))
else True
showTile Tile{..} = show tId ++ "\n" ++ (showP pixels)
showP ps = unlines [[bool ' ' '\x2588' (ps!(r, c)) | c <- [0..cMax] ] | r <- [0..rMax]]
where (_, (rMax, cMax)) = A.bounds ps
-- sb b = bool '.' '#' b
-- -- Parse the input file
tilesP = tileP `sepBy` blankLines
blankLines = many endOfLine
tileP = Tile <$> ("Tile " *> decimal) <* ":" <* endOfLine <*> pixelsP
pixelsP = pixify <$> (pixelsRowP `sepBy` endOfLine)
pixelsRowP = many1 (satisfy (inClass " .#"))
pixify :: [String] -> Pixels
pixify rows = A.array ((0, 0), (nRows, nCols))
[ ((r, c), (rows!!r)!!c == '#')
| r <- [0..nRows]
, c <- [0..nCols]
]
where nRows = length rows - 1
nCols = (length $ head rows) - 1
-- successfulParse :: Text -> (Integer, [Maybe Integer])
successfulParse input =
case parseOnly tilesP input of
Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
Right tiles -> tiles
Tile 1621:
.#.##...#.
#..#..#.#.
#.#..#..##
.....#..#.
.#..#...##
#....#...#
.#........
#.#.#....#
...#...#..
.#..#....#
Tile 3671:
..#.#.###.
#.##....##
#.........
##..#.#...
#..###....
..#.#....#
##..###..#
..#......#
.........#
......###.
Tile 2803:
#.#.#..#..
#.....#...
...##..###
#.#.....##
#...#..#.#
..#...##.#
..#...#..#
####.#..##
#..##....#
#..#.##.#.
Tile 1531:
####.#####
.###...###
##..#..#.#
##.#..#..#
#....#..##
##.#....#.
#.#.##....
....#..#..
#...#.....
##....#...
Tile 1811:
#.#...#..#
##....#.##
#...##.#..
#..##.....
.#.#.....#
##..#.....
##.#......
..#...##..
.#.##....#
##...##..#
Tile 2143:
##.###.#.#
#..##.##..
###.......
..##.#...#
#.......#.
#.#....##.
...#..####
..##...#.#
#.#..#.##.
#.#.#...##
Tile 2887:
.......##.
#..#..#..#
....#.....
...#..##..
..#.......
#...##..##
..#...##..
#.....#.##
##..#..##.
#...#.####
Tile 3511:
.#.##....#
#.#...##.#
#...##.###
....#.....
..#......#
.###.#..#.
#.........
#.#....###
.......#.#
#..#######
Tile 3911:
.#..#.###.
#...#.##..
.#..#...##
##.#.##.##
....#.#..#
...###....
.....#...#
...##..#..
###.#.#.#.
##.....#.#
Tile 3821:
#####..#..
##..#.....
....##.#.#
#....#....
#...##.#.#
#........#
####......
#.#.#....#
....######
..#...###.
Tile 3539:
#####.##..
#........#
####.#....
.##..#.#.#
#.....#...
#.#......#
##...###.#
.#..#.....
#.#.......
...#...#..
Tile 3251:
....#..##.
.###.#...#
#..#.....#
...#.....#
..#.......
.##..#...#
#.......##
#.....#...
....#..#.#
######.#.#
Tile 2677:
.#...#...#
...#.###..
......##..
#.##.##...
#.#...#.##
#..#####..
......##..
......##.#
#..#..#...
..##.####.
Tile 3011:
#.#..#..##
#.###..#..
#..#..##..
#.#..#...#
##...#####
....#..###
.#..#..#.#
..#...#..#
##.##..#.#
.#.##.....
Tile 1489:
#...##.###
#.#..#....
#.....#..#
##..#.....
...#....##
.##.##.#.#
#.#......#
#........#
....#.....
##.#.#####
Tile 3769:
.....####.
##....####
###....#.#
.##..#.#.#
..........
##....####
#...#..#..
...#.....#
##.#.....#
#...##.###
Tile 2293:
.#..#.#...
####......
##...#....
###.#.#...
.##.##...#
......#.#.
##.....#..
#..#.##.##
.##....##.
.#.....#..
Tile 3947:
.#.#...##.
..........
..#...##.#
..###..#.#
##...#.###
.#..#..#..
#.#....#..
....#.#..#
.#....####
######..#.
Tile 1223:
#..#####.#
###..#..##
##.###....
...##.#...
..#.##.#..
##.###...#
...#..#.##
...#..#...
.#....#..#
#..####...
Tile 3331:
#.....##..
##..###.#.
.##.#...#.
.##..#.#..
#......#..
...#.....#
###.#.#...
.##......#
#..#......
...#...###
Tile 3691:
#..#..#.##
......#..#
#.#..##..#
###.......
#.#....##.
##.#..##..
#......#..
..#.......
...#.#..#.
#..#......
Tile 1289:
#.......#.
##.##....#
####......
.#..#.#..#
#.#.#..###
#..#......
##.#####..
.#........
##.##....#
##.#######
Tile 2857:
.#.#..#.##
.....#.#..
#..#...#..
.##...#..#
##..#..#.#
#..#..#..#
...#......
#.#.#.....
##...#....
....#.##..
Tile 3559:
#.##..##..
..#.##.###
##..#....#
#.#..#..#.
##.####..#
.....#...#
#....#....
##..#.##..
#..#.....#
###.##..##
Tile 2633:
...#.#..##
##.......#
#...##..#.
#.#....#.#
.........#
...#.....#
.#.##....#
...#..#...
#.#.##....
..#..##...
Tile 1973:
#.#.....#.
#.......#.
#....#....
.#.#...##.
.........#
#.......#.
...#.##..#
.##...#...
##..#..#..
####..##.#
Tile 1373:
#####.#..#
##.##..###
#.####...#
..###.#...
....##...#
#...#....#
##.#....##
.......#..
##.#.##.#.
#.###.##.#
Tile 1759:
.#.....##.
#.#..#...#
....###..#
........##
....#.....
.....#..#.
#...#....#
.#..#...#.
...#.#.#..
##...#..##
Tile 1213:
#....###.#
###...##.#
.#.....#.#
#......##.
.#...#.##.
.##.......
....##...#
#.........
.........#
#.....#.##
Tile 2341:
#.....#.#.
...##.#..#
.....##..#
......##.#