Day 13: Transparent Origami

haskell/13-transparent-origami.hs

@@ -0,0 +1,83 @@
+module Main where
+
+import Test.Hspec
+
+import Data.Void(Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import Text.Megaparsec.Char.Lexer
+
+import Data.Bifunctor
+import Data.Set(Set,fromList,toList,member,size)
+import qualified Data.Set as S
+
+type Parser = Parsec Void String
+
+type Point = (Int, Int)
+type Paper = Set Point
+data Axis = X | Y deriving (Eq, Ord, Show)
+data Fold = Fold Axis Int deriving (Eq, Ord, Show)
+type Page = (Paper, [Fold])
+
+mkAxis :: Char -> Axis
+mkAxis 'x' = X
+mkAxis 'y' = Y
+mkAxis c = error $ "Invalid axis '" ++ [c] ++ "'; must be one of: x, y"
+
+showPaper :: Paper -> String
+showPaper p = unlines rows
+  where
+    points = toList p
+    xMax = maximum $ map fst points
+    yMax = maximum $ map snd points
+    rows = map mkRow [0..yMax]
+    mkRow y = map (\x -> if member (x, y) p then '#' else ' ') [0..xMax]
+
+pageP :: Parser Page
+pageP = (,) <$> paper <* newline <*> folds
+  where
+    paper = fromList <$> point `endBy` newline
+    point = (,) <$> decimal <* char ',' <*> decimal
+    folds = fold `sepEndBy` newline
+    fold = Fold <$> (string "fold along " *> axis) <* char '=' <*> decimal
+    axis = mkAxis <$> oneOf ['x','y']
+
+foldPoint :: Fold -> Point -> Point
+foldPoint (Fold axis a) = apply update
+  where
+    apply = case axis of X -> first; Y -> second -- Yay! (,) is a Bifunctor!
+    update x = if x > a then 2*a - x else x
+
+
+foldPaper :: Paper -> Fold -> Paper
+foldPaper p f = S.map (foldPoint f) p
+
+foldAll :: [Fold] -> Paper -> Paper
+foldAll fs p = foldl foldPaper p fs
+
+------------------------------------------------------------------------------
+
+main = do
+  runTests
+
+  Right input <- parse pageP "(stdin)" <$> getContents
+  let (paper, folds) = input
+
+  putStr "--\nPart 1: "
+  print $ S.size $ foldPaper paper $ head folds
+  putStrLn "Part 2:"
+  putStrLn $ showPaper $ foldAll folds paper
+
+------------------------------------------------------------------------------
+
+runTests = hspec $ do
+  it "parses input" $ do
+    parse pageP "(test)" testInput `shouldBe` Right testSample
+  it "folds a page" $ do
+    size (foldPaper (fst testSample) (Fold Y 7)) `shouldBe` 17
+  it "does all folds" $ do
+    size ((uncurry . flip) foldAll testSample) `shouldBe` 16
+
+
+testInput = "6,10\n0,14\n9,10\n0,3\n10,4\n4,11\n6,0\n6,12\n4,1\n0,13\n10,12\n3,4\n3,0\n8,4\n1,10\n2,14\n8,10\n9,0\n\nfold along y=7\nfold along x=5"
+testSample = (fromList [(0,3),(0,13),(0,14),(1,10),(2,14),(3,0),(3,4),(4,1),(4,11),(6,0),(6,10),(6,12),(8,4),(8,10),(9,0),(9,10),(10,4),(10,12)],[Fold Y 7,Fold X 5])

haskell/aoc2021.cabal

@@ -60,3 +60,7 @@ executable 11-dumbo-octopus
 executable 12-passage-pathing
  import: deps
  main-is: 12-passage-pathing.hs
+
+executable 13-transparent-origami
+ import: deps
+ main-is: 13-transparent-origami.hs