aboutsummaryrefslogtreecommitdiff
path: root/2020
diff options
context:
space:
mode:
authorJulien Dessaux2023-05-07 23:42:01 +0200
committerJulien Dessaux2023-05-07 23:42:01 +0200
commita9e560d2aa3dea43a6a9f7f64a95e9d9de6cb38b (patch)
tree46a29fb09e60c9e64486622c82a45a2fc65a2430 /2020
parent2020-20 part 1 in haskell (diff)
downloadadvent-of-code-a9e560d2aa3dea43a6a9f7f64a95e9d9de6cb38b.tar.gz
advent-of-code-a9e560d2aa3dea43a6a9f7f64a95e9d9de6cb38b.tar.bz2
advent-of-code-a9e560d2aa3dea43a6a9f7f64a95e9d9de6cb38b.zip
2020-20 part 2 in haskell
Diffstat (limited to '')
-rw-r--r--2020/20-Jurassic_Jigsaw/second.hs216
1 files changed, 216 insertions, 0 deletions
diff --git a/2020/20-Jurassic_Jigsaw/second.hs b/2020/20-Jurassic_Jigsaw/second.hs
new file mode 100644
index 0000000..0990e4f
--- /dev/null
+++ b/2020/20-Jurassic_Jigsaw/second.hs
@@ -0,0 +1,216 @@
+-- requires cabal install --lib megaparsec parser-combinators
+module Main (main) where
+
+import Control.Monad (mapM_, void, when)
+import Data.List (elemIndex, foldl', intercalate, intersect, transpose)
+import Data.Maybe (catMaybes, fromJust, isJust)
+import Data.Map qualified as M
+import Data.Void (Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import System.Exit (die)
+
+exampleExpectedOutput = 273
+
+type TileID = Int
+type Edge = [Bool]
+type Image = [Edge]
+data Tile = Tile { tileID :: TileID
+ , image :: Image
+ , edgesPermutations :: [Edge]
+ }
+type Input = [Tile]
+
+type Parser = Parsec Void String
+
+parseInt :: Parser Int
+parseInt = do
+ n <- some digitChar
+ return $ read n
+
+parseLine :: Parser Edge
+parseLine = do
+ elts <- some (char '#' <|> char '.')
+ void $ char '\n'
+ return $ map (== '#') elts
+
+parseTile :: Parser Tile
+parseTile = do
+ void $ string "Tile "
+ n <- parseInt
+ void $ string ":\n"
+ image <- some parseLine
+ let edges = [head image, last image, map head image, map last image]
+ inverted = map reverse edges
+ return $ Tile n image (edges ++ inverted)
+
+parseInput' :: Parser Input
+parseInput' = do
+ tiles <- some $ parseTile <* (optional $ char '\n')
+ void eof
+ return tiles
+
+parseInput :: String -> IO Input
+parseInput filename = do
+ input <- readFile filename
+ case runParser parseInput' filename input of
+ Left bundle -> die $ errorBundlePretty bundle
+ Right input' -> return input'
+
+oneCornerTopLeftOriented :: [Tile] -> Tile
+oneCornerTopLeftOriented tiles = topLeftOrientation $ (map fst . filter ((== 4) . snd) $ map matchingEdges tiles) !! 0
+ where
+ matchingEdges :: Tile -> (Tile, Int)
+ matchingEdges tile = (tile, sum $ map (matches tile) tiles)
+ matches :: Tile -> Tile -> Int
+ matches Tile{tileID=a, image=_, edgesPermutations=e} Tile{tileID=b, image=_, edgesPermutations=f}
+ | a == b = 0
+ | otherwise = length $ intersect e f
+ topLeftOrientation :: Tile -> Tile
+ topLeftOrientation Tile{tileID=tID, image=img, edgesPermutations=e} = case (leftMatches, topMatches) of
+ (False, False) -> Tile tID img e
+ (False, True) -> Tile tID (rotateRight img) e
+ (True, False) -> Tile tID (rotateLeft img) e
+ (True, True) -> Tile tID (rotateRight $ rotateRight img) e
+ where
+ leftMatches = or $ map (edgeMatch tID (map head img)) tiles
+ topMatches = or $ map (edgeMatch tID (head img)) tiles
+ edgeMatch :: TileID -> Edge -> Tile -> Bool
+ edgeMatch i e tile
+ | i == tileID tile = False
+ | otherwise = isJust $ elemIndex e (edgesPermutations tile)
+
+orientToMatchLeft :: Edge -> Image -> Image
+orientToMatchLeft edge img = rotateLeft . orientToMatchTop (reverse edge) $ rotateRight img -- it took me a long time to find out I needed to reverse the edge!
+
+orientToMatchTop :: Edge -> Image -> Image
+orientToMatchTop edge img
+ | edge == head img = img -- top is top
+ | redg == head img = map reverse img -- top is reverse top
+ | edge == head timg = timg -- top is left
+ | redg == head timg = map reverse timg -- top is reverse left
+ | edge == head rimg = rimg -- top is bottom
+ | redg == head rimg = map reverse rimg -- top is reverse bottom
+ | edge == head rtimg = rtimg -- top is right
+ | redg == head rtimg = map reverse rtimg -- top is reverse right
+ where
+ redg = reverse edge
+ timg = transpose img
+ rimg = reverse img
+ rtimg = reverse timg
+
+buildTileGrid :: [[Tile]] -> M.Map TileID Tile -> [[Tile]]
+buildTileGrid tiles tilesMap
+ | M.size tilesMap == 0 = tiles
+ | isJust nextTileToTheRight = buildTileGrid ((init tiles) ++ [(last tiles) ++ [fromJust nextTileToTheRight]]) (M.delete (tileID $ fromJust nextTileToTheRight) tilesMap)
+ | otherwise = buildTileGrid (tiles ++ [[nextTileBellow]]) (M.delete (tileID nextTileBellow) tilesMap)
+ where
+ lastPlacedTile :: Tile
+ lastPlacedTile = last $ last tiles
+ firstOnLastLine :: Tile
+ firstOnLastLine = head $ last tiles
+ nextTileToTheRight :: Maybe Tile
+ nextTileToTheRight = case filter (edgeMatch rightEdge) (M.elems tilesMap) of
+ [] -> Nothing
+ [a] -> Just (orientedOnTheLeft a)
+ where
+ orientedOnTheLeft :: Tile -> Tile
+ orientedOnTheLeft Tile{tileID=tid, image=img, edgesPermutations=e} = Tile{tileID=tid, image=orientToMatchLeft rightEdge img, edgesPermutations=e}
+ rightEdge :: Edge
+ rightEdge = map last $ image lastPlacedTile
+ nextTileBellow :: Tile
+ nextTileBellow = orientedOnTop . head $ filter (edgeMatch bottomEdge) (M.elems tilesMap)
+ where
+ orientedOnTop :: Tile -> Tile
+ orientedOnTop Tile{tileID=tid, image=img, edgesPermutations=e} = Tile{tileID=tid, image=orientToMatchTop bottomEdge img, edgesPermutations=e}
+ bottomEdge :: Edge
+ bottomEdge = last . image $ firstOnLastLine
+ edgeMatch :: Edge -> Tile -> Bool
+ edgeMatch e tile = isJust $ elemIndex e (edgesPermutations tile)
+
+cropImage :: Image -> Image
+cropImage = tail . init . transpose . tail . init . transpose
+
+assembleLines :: [Image] -> Image
+assembleLines images
+ | length (images !! 0) == 0 = []
+ | otherwise = (concat $ map head images) : (assembleLines $ map tail images)
+
+rotateLeft :: Image -> Image
+rotateLeft = reverse . transpose
+
+rotateRight :: Image -> Image
+rotateRight = transpose . reverse
+
+monster :: Image
+monster = [[ False, False, False, False, False, False, False, False, False, False, False, False, False, False, False, False, False, False, True, False ]
+ ,[ True, False, False, False, False, True, True, False, False, False, False, True, True, False, False, False, False, True, True, True ]
+ ,[ False, True, False, False, True, False, False, True, False, False, True, False, False, True, False, False, True, False, False, False ]]
+
+countMonsters :: Bool -> Image -> Int
+countMonsters goDown i = --(if length z1 < length monster
+ -- then 0
+ -- else if length (z2 !! 0) < length (monster !! 0)
+ -- then 0
+ -- else if match then 1 else 0
+ (if match then 1 else 0) + nexts
+ where
+ z1 :: [(Edge, Edge)]
+ z1 = zip i monster
+ z2 :: [[(Bool, Bool)]]
+ z2 = map (\(e, e') -> zip e e') $ z1
+ match :: Bool
+ match = and $ map (and . map matchOne) z2
+ matchOne :: (Bool, Bool) -> Bool
+ matchOne (_, False) = True
+ matchOne (i, True) = i
+ nexts :: Int
+ nexts = (if goDown && length i > 3 then (countMonsters True $ tail i) else 0) + (if length (i !! 0) > 20 then countMonsters False $ map tail i else 0)
+
+compute :: Input -> Int
+compute tiles = spots - (monsters * 15)
+ where
+ topLeftTile :: Tile
+ topLeftTile = oneCornerTopLeftOriented tiles
+ tilesMap :: M.Map TileID Tile
+ tilesMap = M.delete (tileID topLeftTile) (M.fromList $ zip (map tileID tiles) tiles)
+ imagesGrid :: [[Image]]
+ imagesGrid = map (map image) $ buildTileGrid [[topLeftTile]] tilesMap
+ croppedImages :: [[Image]]
+ croppedImages = map (map cropImage) imagesGrid
+ assembledImage :: Image
+ assembledImage = concat $ map assembleLines croppedImages
+ permutations :: [Image]
+ permutations = let r1 = rotateRight assembledImage
+ r2 = rotateRight r1
+ r3 = rotateRight r2
+ rotations = [assembledImage, r1, r2, r3]
+ inverted = map reverse rotations
+ in rotations ++ inverted
+ monsters :: Int
+ monsters = sum $ map (countMonsters True) permutations
+ spots :: Int
+ spots = length . filter id $ concat assembledImage
+
+main :: IO ()
+main = do
+ example <- parseInput "example"
+ --mapM_ (printImage . image) $ corners example
+ --let topLeftTile = oneCornerTopLeftOriented example
+ -- tilesMap = M.delete (tileID topLeftTile) (M.fromList $ zip (map tileID example) example)
+ -- imagesGrid = map (map image) $ buildTileGrid [[topLeftTile]] tilesMap
+ -- croppedImages = map (map cropImage) imagesGrid
+ -- assembledImage = concat $ map assembleLines croppedImages
+ -- permutations = let r1 = rotateRight assembledImage
+ -- r2 = rotateRight r2
+ -- r3 = rotateRight r3
+ -- rotations = [assembledImage, r1, r2, r3]
+ -- inverted = map reverse rotations
+ -- in rotations ++ inverted
+ --printImage assembledImage
+ let exampleOutput = compute example
+ when (exampleOutput /= exampleExpectedOutput) (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
+ input <- parseInput "input"
+ print $ compute input
+ --where
+ -- printImage img = mapM_ print $ map (map (\x -> if x then '#' else '.')) img