Day 13

1 files changed, 68 insertions, 0 deletions

diff --git a/day13/main.hs b/day13/main.hs
new file mode 100644
index 0000000..fd81216
--- /dev/null
+++ b/day13/main.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main where
+
+import Data.Bifunctor (bimap, first, second)
+import Data.List (foldl', nub)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Text (isPrefixOf, pack, split, unpack)
+import Utils
+
+type Point = (Int, Int)
+
+data Fold = LeftFold Int | UpFold Int deriving (Show)
+
+parseFold :: String -> Fold
+parseFold s =
+  let (coord, num) = drop 11 s $> splitToPair (== '=')
+   in if coord == "x"
+        then LeftFold (read num)
+        else UpFold (read num)
+
+foldLeft :: Int -> [Point] -> [Point]
+foldLeft yLine = map (first (\x -> min x $ yLine + (yLine - x))) .> nub
+
+foldUp :: Int -> [Point] -> [Point]
+foldUp xLine = map (second (\y -> min y $ xLine + (xLine - y))) .> nub
+
+doFold points fold = case fold of
+  LeftFold yLine -> foldLeft yLine points
+  UpFold xLine -> foldUp xLine points
+
+e1 :: [Point] -> [Fold] -> [Point]
+e1 points folds =
+  doFold points (head folds)
+
+printCode :: [Point] -> IO ()
+printCode points =
+  let pointsSet = Set.fromList points
+      xSize = maximum (map fst points) + 1
+      ySize = maximum (map snd points) + 1
+      pointToChar p = if p `elem` pointsSet then '#' else '.'
+      rowStrs = [0 .. ySize - 1] $> map (\y -> [0 .. xSize - 1] $> map (\x -> pointToChar (x, y)))
+   in rowStrs $> map putStrLn .> sequence_
+
+e2 =
+  foldl' doFold
+
+main :: IO ()
+main =
+  do
+    contents <- getContents
+
+    let input =
+          contents
+            $> lines
+            .> break null
+    let pointsStr = fst input
+    let foldsStr = snd input $> drop 1
+
+    let points = pointsStr $> map (splitToPair (== ',') .> bimap read read) :: [Point]
+    let folds = foldsStr $> map parseFold
+
+    let result1 = e1 points folds
+    result1 $> length .> print
+    let result2 = e2 points folds
+    result2 $> length .> print
+    result2 $> printCode