day13: Complete puzzles

13/Parsing.hs

@@ -0,0 +1,32 @@
+module Parsing (
+  splitByString,
+  parseCoordinates
+  ) where
+
+import           Data.List (isPrefixOf)
+
+splitByString :: String -> String -> [String]
+splitByString _ "" = []
+splitByString splitter string =
+  let (chunk, rest) = spanNextSplit string
+  in
+    chunk:(splitByString splitter rest)
+    where
+      spanNextSplit :: String -> (String, String)
+      spanNextSplit [] = ([], [])
+      spanNextSplit everything@(char:rest)
+        | splitter `isPrefixOf` rest =
+          ([char], (drop ((length splitter) + 1) everything))
+        | otherwise =
+          let
+            (start, end) = spanNextSplit rest
+          in
+            (char:start, end)
+
+parseCoordinates :: String -> [(Int, Int)]
+parseCoordinates =
+  map (tuplify . map read . splitByString ",") . lines
+  where
+    tuplify :: [a] -> (a, a)
+    tuplify [a, b] = (a, b)
+    tuplify _      = error "Can't parse coordinates from non-2-sized lists"

13/paperfolder.hs

@@ -0,0 +1,86 @@
+import           Data.List (foldl', nub)
+import           Parsing   (parseCoordinates, splitByString)
+
+main :: IO ()
+main = do
+  input <- getContents
+  let
+    instructions = parseInstructions input
+  (putStrLn . show . solution1) instructions
+  (putStr . solution2) instructions
+
+solution1 :: ([(Int, Int)], [(Int, Int)]) -> Int
+solution1 (paper, folds) = (length . nub) (foldPaper paper (folds !! 0))
+
+solution2 :: ([(Int, Int)], [(Int, Int)]) -> String
+solution2 (paper, folds) = printPaper (foldl' (foldPaper) paper folds)
+
+foldPaper :: [(Int, Int)] -> (Int, Int) -> [(Int, Int)]
+foldPaper paper axis = map (fold axis) paper
+  where
+    fold :: (Int, Int) -> (Int, Int) -> (Int, Int)
+    fold (0, a) (x, y)
+      | y < a = (x, y)
+      | y > a = (x, flipCoord y a)
+    fold (a, 0) (x, y)
+      | x < a = (x, y)
+      | x > a = (flipCoord x a, y)
+    fold _ _ = undefined -- Only axis-folds are defined
+    flipCoord :: Int -> Int -> Int
+    flipCoord c a = a - (c - a)
+
+printPaper :: [(Int, Int)] -> String
+printPaper = unlines . coordsToPaper
+  where
+    coordsToPaper :: [(Int, Int)] -> [String]
+    coordsToPaper dots = [[if (x, y) `elem` dots then '█' else ' ' |
+                           x <- [0..maximum (map fst dots)]] |
+                          y <- [0..maximum (map snd dots)]]
+
+parseInstructions :: String -> ([(Int, Int)], [(Int, Int)])
+parseInstructions input =
+  (dots, folds)
+  where
+    split :: [String]
+    split = splitByString "\n\n" input
+    dots :: [(Int, Int)]
+    dots = (parseCoordinates . head) split
+    folds :: [(Int, Int)]
+    folds = (map (tuplify . splitByString "=") . lines . last) split
+    tuplify :: [String] -> (Int, Int)
+    tuplify [] = error "Can't turn an empty list into fold instructions"
+    tuplify (fold:axis)
+      | last fold == 'x' = (read (head axis), 0)
+      | last fold == 'y' = (0, read (head axis))
+      | otherwise = error "Fold instructions must go across x or y"
+
+-- Tests
+
+testInput1 = unlines [
+  "6,10",
+  "0,14",
+  "9,10",
+  "0,3",
+  "10,4",
+  "4,11",
+  "6,0",
+  "6,12",
+  "4,1",
+  "0,13",
+  "10,12",
+  "3,4",
+  "3,0",
+  "8,4",
+  "1,10",
+  "2,14",
+  "8,10",
+  "9,0",
+  "",
+  "fold along y=7",
+  "fold along x=5"]
+
+testInput1Parsed = parseInstructions testInput1
+test1 = solution1 testInput1Parsed
+test2 = putStr (solution2 testInput1Parsed)
+
+testPrinted1 = putStr (printPaper (foldPaper (fst testInput1Parsed) (head (snd testInput1Parsed))))