day 15: rewrite part 2

Signed-off-by: Amneesh Singh <natto@weirdnatto.in>

.envrc

@@ -0,0 +1 @@
+use flake

Lib.hs

@@ -0,0 +1,8 @@
+module Lib (readFile') where
+
+import qualified Data.ByteString as B (readFile)
+import Data.Text (Text)
+import qualified Data.Text.Encoding as T (decodeUtf8)
+
+readFile' :: FilePath -> IO Text
+readFile' f = T.decodeUtf8 <$> B.readFile f

README

@@ -0,0 +1 @@
+My advent of code solutions for 2022. I am trying to not use String ([Char]) wherever possible and use Data.Text instead. That makes the programs appear bigger than they are LOC-wise.

day01.hs

@@ -0,0 +1,21 @@
+import Data.Either (isLeft, rights)
+import Data.List (sortOn)
+import Data.Ord (Down (Down))
+import Data.Text (Text)
+import qualified Data.Text as T (lines)
+import qualified Data.Text.Read as T (decimal)
+import Lib (readFile')
+
+main :: IO ()
+main = do
+  input <- map T.decimal . T.lines <$> readFile' "day1.in"
+  putStr "Q1: "
+  print . maximum $ calories input
+  putStr "Q2: "
+  print . sum . take 3 . sortOn Down $ calories input
+
+calories :: [Either String (Int, Text)] -> [Int]
+calories [] = []
+calories input =
+  let (cur, rest) = break isLeft input
+   in sum (map fst $ rights cur) : calories (drop 1 rest)

day02.hs

@@ -1,8 +1,12 @@
+import Data.Text (Text)
+import qualified Data.Text as T (lines, unpack)
+import Lib (readFile')
+
 -- we do not use a simple 9 value case cuz yeah
 
 main :: IO ()
 main = do
-  choices <- parse <$> readFile "day2.in"
+  choices <- parse <$> readFile' "day2.in"
   putStr "Q1: "
   print $ q1 choices
   putStr "Q2: "
@@ -17,8 +21,8 @@ instance Ord Choice where
   compare Scissors Rock = LT
   compare _ _ = GT
 
-parse :: String -> [(Choice, Choice)]
-parse = map (\[x, _, y] -> (val x 'A', val y 'X')) . lines
+parse :: Text -> [(Choice, Choice)]
+parse = map ((\[x, _, y] -> (val x 'A', val y 'X')) . T.unpack) . T.lines
 
 score :: (Choice, Choice) -> Int
 score (i, j) = 1 + fromEnum j + 3 * fromEnum (compare j i)

day03.hs

@@ -0,0 +1,31 @@
+import Data.Char (isAsciiLower, isAsciiUpper)
+import Data.List (intersect)
+import Data.Text (Text)
+import qualified Data.Text as T (foldl, lines, splitAt)
+import Lib (readFile')
+
+main :: IO ()
+main = do
+  input <- map parse . T.lines <$> readFile' "day3.in"
+  putStr "Q1: "
+  print $ q1 input
+  putStr "Q2: "
+  print $ q2 input
+
+q1 :: [[Int]] -> Int
+q1 = sum . map (\x -> head . uncurry intersect $ splitAt (div (length x) 2) x)
+
+q2 :: [[Int]] -> Int
+q2 [] = 0
+q2 input =
+  let (cur, rest) = splitAt 3 input
+   in (head . foldr1 intersect) cur + q2 rest
+
+parse :: Text -> [Int]
+parse = T.foldl (\xs x -> val x : xs) []
+
+val :: Char -> Int
+val c
+  | isAsciiLower c = 1 + fromEnum c - fromEnum 'a'
+  | isAsciiUpper c = 27 + fromEnum c - fromEnum 'A'
+  | otherwise = 0

day04.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.Char (isDigit)
+import Data.Either (rights)
+import Data.Maybe (fromJust)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, stripPrefix)
+import qualified Data.Text.Read as T (decimal)
+import Lib (readFile')
+
+main :: IO ()
+main = do
+  input <- rights . map parse . T.lines <$> readFile' "day4.in"
+  putStr "Q1: "
+  print $ q1 input
+  putStr "Q2: "
+  print $ q2 input
+
+parse :: Text -> Either String ((Int, Int), (Int, Int))
+parse rest = do
+  (a, rest) <- T.decimal rest
+  (b, rest) <- T.decimal $ fromJust $ T.stripPrefix "-" rest
+  (c, rest) <- T.decimal $ fromJust $ T.stripPrefix "," rest
+  (d, rest) <- T.decimal $ fromJust $ T.stripPrefix "-" rest
+  return ((a, b), (c, d))
+
+q1, q2 :: [((Int, Int), (Int, Int))] -> Int
+q1 = length . filter (\((a, b), (c, d)) -> a >= c && b <= d || c >= a && d <= b)
+q2 = length . filter (\((a, b), (c, d)) -> b >= c && a <= d)

day05.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+import Data.List (foldl')
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Data.Text as T
+import Lib (readFile')
+
+main :: IO ()
+main = do
+  input <- break (== T.empty) . T.lines <$> readFile' "day5.in"
+  let (crates, cmds) = parse input
+  putStr "Q1: "
+  print $ moveCrates T.reverse crates cmds
+  putStr "Q2: "
+  print $ moveCrates id crates cmds
+
+moveCrates :: (Text -> Text) -> [Text] -> [(Int, Int, Int)] -> Text
+moveCrates f crates' cmds = head . T.transpose . M.elems $ foldl' move crates cmds
+  where
+    crates :: Map Int Text
+    crates = M.fromList $ zip [0 ..] crates'
+    move :: Map Int Text -> (Int, Int, Int) -> Map Int Text
+    move c (n, x, y) =
+      let (h, t) = T.splitAt n $ c M.! x
+       in M.update (Just . (<>) (f h)) y $ M.insert x t c
+
+-- ugly code vs line length <= 90 🤔
+parse :: ([Text], [Text]) -> ([Text], [(Int, Int, Int)])
+parse (crates, cmds) =
+  ( [ T.filter (/= ' ') x
+      | (i, x) <- zip [0 ..] (T.transpose $ init crates),
+        i `mod` 4 == 1
+    ],
+    map
+      ( ( \["move", T.unpack -> n, "from", T.unpack -> x, "to", T.unpack -> y] ->
+            (read n, read x - 1, read y - 1)
+        )
+          . T.words
+      )
+      $ tail cmds
+  )

day06.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.List (nub)
+import Lib (readFile')
+import Data.Text (Text)
+import qualified Data.Text as T
+
+main :: IO ()
+main = do
+  input <- readFile' "day6.in"
+  putStr "Q1: "
+  print $ parse 4 input
+  putStr "Q2: "
+  print $ parse 14 input
+
+group :: Int -> Text -> [Text]
+group _ "" = []
+group n xs = T.take n xs : group n (T.tail xs)
+
+parse :: Int -> Text -> Int
+parse n = (+ n) . length . takeWhile ((< n) . length) . map (nub . T.unpack) . group n

day07'.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.Either (rights)
+import Data.Text (Text)
+import qualified Data.Text as T (head, lines, words)
+import qualified Data.Text.Read as T (decimal)
+import Data.Tree
+import Lib (readFile')
+
+main :: IO ()
+main = do
+  tree <- snd . flip parse (emptyFs "/") . map T.words . T.lines <$> readFile' "day7.in"
+  putStr "Q1: "
+  print $
+    foldTree
+      ( \x xs ->
+          if null xs || snd x > 100000 then sum xs else snd x + sum xs
+      )
+      tree
+  putStr "Q2: "
+  let maxStorage = 70000000
+  let spaceNeeded = 30000000 - (maxStorage - snd (rootLabel tree))
+  print $
+    foldTree
+      ( \x xs ->
+          if snd x < spaceNeeded
+            then minimum (maxStorage : xs)
+            else minimum (snd x : xs)
+      )
+      tree
+
+type Filesystem = Tree (Text, Int)
+
+tail' :: [a] -> [a]
+tail' = drop 1
+
+emptyFs :: Text -> Filesystem
+emptyFs n = Node (n, 0) []
+
+insertFs :: Filesystem -> Text -> Filesystem -> Filesystem
+insertFs (Node n xs) name fs = Node (fst n, snd n + snd (rootLabel fs)) (fs : xs)
+
+ls :: [[Text]] -> [Filesystem]
+ls =
+  map (\[a, b] -> Node (b, fst . head $ rights [T.decimal a]) [])
+    . filter ((/= "dir") . head)
+
+totalSize :: [Filesystem] -> Int
+totalSize = sum . map (snd . rootLabel)
+
+parse :: [[Text]] -> Filesystem -> ([[Text]], Filesystem)
+parse input fs
+  | null input || cur == ["$", "cd", ".."] = (tail' input, fs)
+  | cur == ["$", "ls"] =
+    let (children, rest) = span ((/= "$") . head) (tail' input)
+        leaves = ls children
+        name = fst $ rootLabel fs
+     in parse rest (Node (name, totalSize leaves) leaves)
+  | otherwise =
+    let name = cur !! 2
+        (nextInput, newFs) = parse (tail' input) (emptyFs name)
+        replaced = insertFs fs name newFs
+     in parse nextInput replaced
+  where
+    cur = head input

day07.hs

@@ -0,0 +1,86 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.Either (rights)
+import Data.Text (Text)
+import qualified Data.Text as T (head, lines, words)
+import qualified Data.Text.Read as T (decimal)
+import Data.Tree
+import Lib (readFile')
+
+-- this solution assumes that empty directories can exist,
+-- if you want to ignore that, there is a slightly different code in day7'.hs
+
+-- needs cleaning and improvement, although i like the fact
+-- that the entire FS can be printed as a tree
+
+main :: IO ()
+main = do
+  tree <- snd . flip parse (emptyFs "/") . map T.words . T.lines <$> readFile' "day7.in"
+  putStr "Q1: "
+  print $
+    foldTree
+      ( \x xs ->
+          if null xs || snd x > 100000 then sum xs else snd x + sum xs
+      )
+      tree
+  putStr "Q2: "
+  let maxStorage = 70000000
+  let spaceNeeded = 30000000 - (maxStorage - snd (rootLabel tree))
+  print $
+    foldTree
+      ( \x xs ->
+          if snd x < spaceNeeded
+            then minimum (maxStorage : xs)
+            else minimum (snd x : xs)
+      )
+      tree
+
+type Filesystem = Tree (Text, Int)
+
+tail' :: [a] -> [a]
+tail' = drop 1
+
+-- wrapper to create an empty tree
+emptyFs :: Text -> Filesystem
+emptyFs n = Node (n, 0) []
+
+-- This function is to replace a filesystem by name
+-- Used to replace empty directories with parsed directories in code
+replaceFs :: Filesystem -> Text -> Filesystem -> Filesystem
+replaceFs (Node n xs) name fs =
+  let (h, t) = span ((/= name) . fst . rootLabel) xs
+   in Node
+        (fst n, snd n + snd (rootLabel fs))
+        (h ++ [fs] ++ tail' t)
+
+-- Sum of all filesystems in the list
+-- Used to calculate sum of leaves in code
+totalSize :: [Filesystem] -> Int
+totalSize = sum . map (snd . rootLabel)
+
+-- All directories/files are parsed here into leaves
+ls :: [[Text]] -> [Filesystem]
+ls =
+  map
+    ( \[a, b] ->
+        if a == "dir"
+          then Node (b, 0) []
+          else Node (b, fst . head $ rights [T.decimal a]) []
+    )
+
+-- main function where stuff happens
+parse :: [[Text]] -> Filesystem -> ([[Text]], Filesystem)
+parse input fs
+  | null input || cur == ["$", "cd", ".."] = (tail' input, fs)
+  | cur == ["$", "ls"] =
+    let (children, rest) = span ((/= "$") . head) (tail' input)
+        leaves = ls children
+        name = fst $ rootLabel fs
+     in parse rest (Node (name, totalSize leaves) leaves)
+  | otherwise =
+    let name = cur !! 2
+        (nextInput, newFs) = parse (tail' input) (emptyFs name)
+        replaced = replaceFs fs name newFs -- replace empty directory
+     in parse nextInput replaced
+  where
+    cur = head input

day08.hs

@@ -0,0 +1,48 @@
+import Data.List (scanl, tails, transpose, zip4, zipWith4)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, unpack)
+import Lib (readFile')
+
+-- new approach was hinted by an anon but I cannot quite get it right
+-- a fun approach, not necessarily the fastest (or cleanest (or smartest))
+
+main :: IO ()
+main = do
+  input <- map T.unpack . T.lines <$> readFile' "day8.in"
+  putStr "Q1: "
+  print $ q1 input
+  putStr "Q2: "
+  print $ q2 input
+
+layer :: [[Char]] -> (a -> a -> a) -> ([[Char]] -> [[a]]) -> [[a]]
+layer input f f' =
+  zipWith4 ( zipWith4 (\w x y z -> f w . f x $ f y z) )
+    (f' e)
+    (map reverse $ f' w)
+    (transpose $ f' n)
+    (reverse . transpose $ f' s)
+  where
+    (e, w, n, s) =
+      ( input,
+        map reverse input,
+        transpose input,
+        transpose $ reverse input
+      ) -- (east, west, north, south]
+
+q1 :: [[Char]] -> Int
+q1 input = length . filter not . concat $ layer input (&&) q1'
+  where
+    q1' :: [[Char]] -> [[Bool]]
+    q1' = map (\x -> zipWith (<=) x $ scanl max minBound x)
+
+q2 :: [[Char]] -> Int
+q2 input = maximum . concat $ layer input (*) q2'
+  where
+    q2' :: [[Char]] -> [[Int]]
+    q2' =
+      map
+        ( \a ->
+            [ let l = length (takeWhile (< x) xs) in (+ l) . fromEnum $ length xs /= l
+              | (x : xs) <- tails a
+            ]
+        )

day09.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+import Data.List (nub, scanl)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, unpack, words)
+import qualified Data.Text.Read as T (decimal)
+import Lib (readFile')
+
+-- a rather slow program, takes 300 ms on my system (with `time`, but idc anymore 😭
+
+main :: IO ()
+main = do
+  input <-
+    concatMap
+      ((\[T.unpack -> [d], T.decimal -> Right (n, "")] -> replicate n d) . T.words)
+      . T.lines
+      <$> readFile' "day9.in"
+  putStr "Q1: "
+  print $ q 1 input
+  putStr "Q2: "
+  print $ q 9 input
+
+moveHead :: Char -> (Int, Int) -> (Int, Int)
+moveHead d (x, y) = case d of
+  'L' -> (x - 1, y)
+  'R' -> (x + 1, y)
+  'U' -> (x, y + 1)
+  'D' -> (x, y - 1)
+
+moveTail :: (Int, Int) -> (Int, Int) -> (Int, Int)
+moveTail (hx, hy) (tx, ty)
+  | abs dx <= 1 && abs dy <= 1 = (tx, ty) -- dont move
+  | abs dx > abs dy = (tx + signum dx, hy) -- move horizontally
+  | abs dy > abs dx = (hx, ty + signum dy) -- move vertically
+  | otherwise = (tx + signum dx, ty + signum dy ) -- move diagonally
+  where
+    dx = hx - tx
+    dy = hy - ty
+
+q :: Int -> [Char] -> Int
+q n =
+  length . nub . map last
+    . scanl
+      ( \(h : t) d ->
+          reverse $ foldl (\(h : xs) x -> moveTail h x : (h : xs)) [moveHead d h] t
+      )
+      (replicate (n + 1) (0, 0))

day1.hs

@@ -1,22 +0,0 @@
-import Data.List (sortOn)
-import Data.Ord (Down (Down))
-
-main :: IO ()
-main = do
-  input <- lines <$> readFile "day1.in"
-  putStr "Q1: "
-  print $ q1 input
-  putStr "Q2: "
-  print $ q2 input
-
-q1 :: [String] -> Int
-q1 = maximum . calories
-
-q2 :: [String] -> Int
-q2 = sum . take 3 . sortOn Down . calories
-
-calories :: [String] -> [Int]
-calories [] = []
-calories input =
-  let (cur, rest) = break null input
-   in sum (map read cur) : calories (drop 1 rest)

day10.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+import Data.Text (Text)
+import qualified Data.Text as T (lines, pack, unlines, words)
+import qualified Data.Text.IO as T (putStr)
+import qualified Data.Text.Read as T (decimal, signed)
+import Lib (readFile')
+
+main :: IO ()
+main = do
+  vals <-
+    scanl1 (+)
+      . reverse
+      . foldl
+        ( \xs x ->
+            let o : n = T.words x
+                dec (T.signed T.decimal . head -> Right (m, "")) = m
+             in if o == "noop" then 0 : xs else dec n : 0 : xs
+        )
+        [1]
+      . T.lines
+      <$> readFile' "day10.in"
+  putStr "Q1: "
+  print $ q1 vals
+  putStrLn "Q2: "
+  T.putStr $ q2 vals
+
+q1 :: [Int] -> Int
+q1 v = foldr (\x xs -> xs + (v !! (x - 1) * x)) 0 [20, 60 .. 220]
+
+q2 :: [Int] -> Text
+q2 v =
+  T.unlines $
+    map
+      ( \x ->
+          T.pack $
+            map (\y -> if abs (v !! (x + y) - y) <= 1 then '#' else '.') [0 .. 39]
+      )
+      [0, 40 .. 200]

day11.hs

@@ -0,0 +1,109 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+import Data.Either (rights)
+import Data.List (sortOn)
+import Data.Map (Map)
+import qualified Data.Map as M (elems, fromList, insert, keys, lookup, update)
+import Data.Maybe (fromJust)
+import Data.Ord (Down (Down))
+import Data.Text (Text)
+import qualified Data.Text as T (empty, init, lines, stripSuffix, words)
+import qualified Data.Text.Read as T (decimal, signed)
+import Lib (readFile')
+import Prelude hiding (round)
+
+-- again a slow program ;-; takes 410 ms when measured with `time`
+
+main :: IO ()
+main = do
+  input <- parse . T.lines <$> readFile' "day11.in"
+  putStr "Q1: "
+  print $ q 3 20 input
+  putStr "Q2: "
+  print $ q 1 10000 input
+
+data Monkey = Banana
+  { items :: [Int],
+    operation :: Int -> Int -> Int,
+    factor :: Int,
+    next :: (Int, Int),
+    iCount :: Int
+  }
+
+q :: Int -> Int -> Map Int Monkey -> Int
+q d n =
+  product . take 2
+    . sortOn Down
+    . map iCount
+    . M.elems
+    . (!! n)
+    . iterate (round d)
+
+round :: Int -> Map Int Monkey -> Map Int Monkey
+round d monkeys =
+  foldl
+    ( \m k ->
+        let (Banana items op f (a, b) c) = fromJust $ M.lookup k m
+         in M.insert k (Banana [] op f (a, b) (c + length items)) $
+              foldr
+                ( \x m ->
+                    let worry = op x d `mod` divisor
+                     in M.update
+                          ( Just
+                              . ( \(Banana items' op' f' n' c') ->
+                                    Banana (worry : items') op' f' n' c'
+                                )
+                          )
+                          (if worry `mod` f == 0 then a else b)
+                          m
+                )
+                m
+                items
+    )
+    monkeys
+    (M.keys monkeys)
+  where
+    divisor :: Int
+    divisor = foldr1 lcm (map factor $ M.elems monkeys)
+
+parse :: [Text] -> Map Int Monkey
+parse =
+  M.fromList
+    . map
+      ( \( (parseMonkey -> n)
+             : (parseItems -> xs)
+             : (parseOp -> op)
+             : (parseTest -> (f, a, b))
+           ) -> (n, Banana xs op f (a, b) 0)
+      )
+    . sLines
+  where
+    parseMonkey :: Text -> Int
+    parseMonkey (T.words -> ["Monkey", T.decimal . T.init -> Right (n, "")]) = n
+
+    parseItems :: Text -> [Int]
+    parseItems (T.words -> "Starting" : "items:" : xs) =
+      map (\(T.decimal -> Right (n, _)) -> n) xs
+
+    parseOp :: Text -> (Int -> Int -> Int)
+    parseOp (T.words -> ["Operation:", "new", "=", e1, o, e2]) =
+      \x d -> div (parseO o (parseE x e1) (parseE x e2)) d
+      where
+        parseO o = if o == "+" then (+) else (*)
+        parseE x e = case T.decimal e of
+          Right (n, "") -> n
+          Left _ -> x
+
+    parseTest :: [Text] -> (Int, Int, Int)
+    parseTest
+      [ T.words -> ["Test:", "divisible", "by", T.decimal -> Right (t, "")],
+        T.words -> ["If", "true:", "throw", "to", "monkey", T.decimal -> Right (a, "")],
+        T.words -> ["If", "false:", "throw", "to", "monkey", T.decimal -> Right (b, "")]
+        ] = (t, a, b)
+
+    sLines :: [Text] -> [[Text]]
+    sLines [] = []
+    sLines input =
+      let (cur, rest) = break (== T.empty) input
+       in cur : sLines (drop 1 rest)

day12.hs

@@ -0,0 +1,77 @@
+{-# OPTIONS_GHC -Wno-missing-methods #-}
+
+import Control.Monad (ap)
+import Data.Map (Map)
+import qualified Data.Map as M (filter, fromList, keys, (!), (!?))
+import Data.Set (Set)
+import qualified Data.Set as S (deleteAt, elemAt, empty, fromList, insert, member, null, singleton, union)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, unpack)
+import Lib (readFile')
+
+main :: IO ()
+main = do
+  input <- parse . T.lines <$> readFile' "day12.in"
+  print $ head . M.keys $ M.filter (== S) input
+  putStr "Q1: "
+  print $ shortest (S.singleton (0, head . M.keys $ M.filter (== S) input)) input E
+  putStr "Q2: "
+  print $
+    shortest
+      ( S.fromList
+          ( zip
+              (repeat 0)
+              (M.keys $ M.filter (\x -> x == S || x == height 'a') input)
+          )
+      )
+      input
+      E
+
+data Height = Height Int | S | E deriving (Show, Eq)
+
+-- no need to implement toEnum
+instance Enum Height where
+  fromEnum S = 0
+  fromEnum E = 25
+  fromEnum (Height h) = h
+
+height :: Char -> Height
+height 'E' = E
+height 'S' = S
+height c = Height $ fromEnum c - fromEnum 'a'
+
+parse :: [Text] -> Map (Int, Int) Height
+parse =
+  M.fromList . concat
+    . zipWith zip (map (\x -> zip (repeat x) [0 ..]) [0 ..])
+    . map (map height . T.unpack)
+
+nextPos :: (Int, Int) -> Map (Int, Int) Height -> [(Int, Int)]
+nextPos (x, y) m = filter check [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]
+  where
+    check :: (Int, Int) -> Bool
+    check (x', y') =
+      maybe
+        False
+        (<= (succ . fromEnum $ m M.! (x, y)))
+        (fromEnum <$> m M.!? (x', y'))
+
+-- using set as a queue cuz yh
+shortest :: Set (Int, (Int, Int)) -> Map (Int, Int) Height -> Height -> Int
+shortest queue graph end = bfs queue S.empty
+  where
+    bfs :: Set (Int, (Int, Int)) -> Set (Int, Int) -> Int
+    bfs queue vis
+      | graph M.! (x, y) == end = now
+      | otherwise = bfs newqueue (S.insert (x, y) vis)
+      where
+        (now, (x, y)) = S.elemAt 0 queue
+        newqueue =
+          S.union
+            (S.deleteAt 0 queue)
+            ( S.fromList
+                ( zip
+                    (repeat (now + 1))
+                    (filter (not . flip S.member vis) $ nextPos (x, y) graph)
+                )
+            )

day13.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+import Data.Char (isDigit)
+import Data.List (elemIndex, sort)
+import Data.Maybe (fromJust)
+import Data.Text (Text)
+import qualified Data.Text as T (filter, init, lines, null, span, tail, uncons)
+import qualified Data.Text.Read as T (decimal)
+import Lib (readFile')
+
+main :: IO ()
+main = do
+  input <-
+    map (fst . parse (List []) . T.init . T.tail) . filter (not . T.null)
+      . T.lines
+      <$> readFile' "day13.in"
+  putStr "Q1: "
+  print $ q1 input
+  putStr "Q2: "
+  print $ q2 input (List [List [Elem 2]]) (List [List [Elem 6]])
+
+q1 :: [List] -> Int
+q1 input =
+  foldl
+    (\xs x -> xs + if input !! (2 * x - 2) < input !! (2 * x - 1) then x else 0)
+    0
+    [1 .. length input `div` 2]
+
+q2 :: [List] -> List -> List -> Int
+q2 input a b =
+  let sorted = sort (a : b : input)
+      a' = fromJust $ elemIndex a sorted
+      b' = fromJust $ elemIndex b sorted
+   in (a' + 1) * (b' + 1)
+
+data List = Elem Int | List [List] deriving (Show, Eq)
+
+-- is this cheating :P
+instance Ord List where
+  compare (List xs) (List ys) = compare (reverse xs) (reverse ys)
+  compare (List xs) (Elem y) = compare (List xs) (List [Elem y])
+  compare (Elem x) (List ys) = compare (List [Elem x]) (List ys)
+  compare (Elem x) (Elem y) = compare x y
+
+-- Weak parser but it works
+-- I do not really know how to use Parsec and ReadP with Data.Text yet
+
+parse :: List -> Text -> (List, Text)
+parse (List xs) txt
+  | T.null txt || cur == ']' = (List xs, rest)
+  | cur == '[' =
+    let (new, next) = parse (List []) rest
+     in parse (List (new : xs)) next
+  | isDigit cur = parse (List (Elem num : xs)) rest'
+  | otherwise = parse (List xs) rest
+  where
+    (cur, rest) = fromJust $ T.uncons txt
+    (T.decimal -> Right (num, ""), rest') = T.span isDigit txt

day14.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+import Data.Maybe (fromJust)
+import Data.Set (Set)
+import qualified Data.Set as S (fromList, insert, map, member, notMember, union)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, splitOn, words)
+import qualified Data.Text.Read as T (decimal)
+import Lib (readFile')
+
+-- times can be improved greatly using Data.HashSet in unordered-containers, but i wont use it
+
+main :: IO ()
+main = do
+  input <- parse . T.lines <$> readFile' "day14.in"
+  let mx = maximum $ S.map snd input
+  putStr "Q1: "
+  print $ sand (500, 0) input 0 mx Q1
+  putStr "Q2: "
+  print $ sand (500, 0) input 0 (mx + 2) Q2
+
+type Coord = (Int, Int)
+
+data Q = Q1 | Q2 deriving (Eq)
+
+sand :: Coord -> Set Coord -> Int -> Int -> Q -> Int
+sand (x, y) rocks soFar mx q
+  | (q == Q1 && y > mx) || S.member (x, y) rocks = soFar
+  | q == Q2 && y + 1 == mx = sand (500, 0) (S.insert (x, y) rocks) (soFar + 1) mx q
+  | S.notMember (x, y + 1) rocks = sand (x, y + 1) rocks soFar mx q
+  | S.notMember (x - 1, y + 1) rocks = sand (x - 1, y + 1) rocks soFar mx q
+  | S.notMember (x + 1, y + 1) rocks = sand (x + 1, y + 1) rocks soFar mx q
+  | otherwise = sand (500, 0) (S.insert (x, y) rocks) (soFar + 1) mx q
+
+parse :: [Text] -> Set Coord
+parse =
+  S.fromList
+    . concatMap
+      ( ranges
+          . map
+            ( (\[x, y] -> (x, y))
+                . map (\(T.decimal -> Right (n, "")) -> n)
+                . T.splitOn ","
+            )
+          . filter (/= "->")
+          . T.words
+      )
+  where
+    ranges :: [Coord] -> [Coord]
+    ranges xs =
+      foldr
+        ( \((a, b), (x, y)) z ->
+            if a == x
+              then zip (repeat a) [min b y .. max b y] ++ z
+              else zip [min a x .. max a x] (repeat b) ++ z
+        )
+        []
+        (zip xs (tail xs))

day15.hs

@@ -0,0 +1,115 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+import Data.List (nub, sort)
+import Data.Maybe (catMaybes)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, null, split)
+import qualified Data.Text.Read as T (decimal, signed)
+import Lib (readFile')
+
+main :: IO ()
+main = do
+  input <- map parse . T.lines <$> readFile' "day15.in"
+  putStr "Q1: "
+  print $ q1 input 2000000
+  putStr "Q2: "
+  print $ q2 input 0 4000000
+
+type Coords = (Int, Int, Int, Int, Int)
+
+q1 :: [Coords] -> Int -> Int
+q1 input n = mergeRanges getRanges
+  where
+    mergeRanges :: [(Int, Int)] -> Int
+    mergeRanges [(x0, x1)] = x1 - x0 + 1
+    mergeRanges ((x0, x1) : (x2, x3) : xs)
+      | x2 - x1 < 2 = mergeRanges $ (x0, max x1 x3) : xs
+      | otherwise = x1 - x0 + 1 + mergeRanges ((x2, x3) : xs)
+
+    getRanges :: [(Int, Int)]
+    getRanges =
+      sort $
+        foldr
+          ( \(x, y, r, a, b) xs -> case r - abs (n - y) of
+              dx
+                | dx < 0 -> xs
+                | n == b -> (x - dx, a - 1) : (a + 1, x + dx) : xs
+                | otherwise -> (x - dx, x + dx) : xs
+          )
+          []
+          input
+
+type Segment = (Int, Int, Int, Int)
+
+q2 input mn mx =
+  head
+    [ a * mx + b
+      | (a, b) <- diag1234,
+        a >= mn && b >= mn && a <= mx && b <= mx,
+        and [abs (b - y) + abs (a - x) > r | (x, y, r, _, _) <- input]
+    ]
+  where
+    diag1, diag2, diag3, diag4 :: Coords -> Segment
+    diag1 (x, y, r, _, _) = (x - r - 1, y, x, y - r - 1)
+    diag2 (x, y, r, _, _) = (x, y - r - 1, x + r + 1, y)
+    diag3 (x, y, r, _, _) = (x, y + r + 1, x + r + 1, y)
+    diag4 (x, y, r, _, _) = (x - r - 1, y, x, y + r + 1)
+
+    diagInt :: Segment -> Segment -> Maybe Segment
+    diagInt a@(x0, y0, x1, y1) b@(x2, y2, x3, y3)
+      | x3 < x0 || x1 < x2 = Nothing
+      | x0 >= x2 && x1 <= x3 = Just a
+      | x2 >= x0 && x3 <= x1 = Just b
+      | x3 >= x1 = Just (x2, y2, x1, y1)
+      | x1 >= x3 = Just (x0, y0, x3, y3)
+
+    diag13, diag24 :: [Segment]
+    diag13 =
+      catMaybes
+        [ diagInt i j
+          | a <- input,
+            b <- input,
+            let i@(x0, y0, x1, y1) = diag1 a,
+            let j@(x2, y2, x3, y3) = diag3 b,
+            a /= b,
+            x0 + y0 == x2 + y2
+        ]
+    diag24 =
+      catMaybes
+        [ diagInt i j
+          | a <- input,
+            b <- input,
+            let i@(x0, y0, x1, y1) = diag2 a,
+            let j@(x2, y2, x3, y3) = diag4 b,
+            a /= b,
+            y0 - x0 == y2 - x2
+        ]
+
+    diag1234 :: [(Int, Int)]
+    diag1234 =
+      [ let (c1, c2) = (y0 + x0, y2 - x2) in (div (c1 - c2) 2, div (c1 + c2) 2)
+        | (x0, y0, x1, y1) <- diag13,
+          (x2, y2, x3, y3) <- diag24
+      ]
+
+parse :: Text -> Coords
+parse =
+  ( \[ "Sensor",
+       "at",
+       "x",
+       T.signed T.decimal -> Right (x, ""),
+       "y",
+       T.signed T.decimal -> Right (y, ""),
+       "closest",
+       "beacon",
+       "is",
+       "at",
+       "x",
+       T.signed T.decimal -> Right (a, ""),
+       "y",
+       T.signed T.decimal -> Right (b, "")
+       ] -> (x, y, abs (b - y) + abs (a - x), a, b)
+  )
+    . filter (not . T.null)
+    . T.split (`elem` (":=, " :: [Char]))

day3.hs

@@ -1,27 +0,0 @@
-import Data.Char (isAsciiLower, isAsciiUpper)
-import Data.List (intersect)
-
-main :: IO ()
-main = do
-  input <- lines <$> readFile "day3.in"
-  putStr "Q1: "
-  print $ q1 input
-  putStr "Q2: "
-  print $ q2 input
-
-q1 :: [String] -> Int
-q1 =
-  sum
-    . map (\x -> val . head . uncurry intersect $ splitAt (div (length x) 2) x)
-
-q2 :: [String] -> Int
-q2 [] = 0
-q2 input =
-  let (cur, rest) = splitAt 3 input
-   in (val . head . foldr1 intersect) cur + q2 rest
-
-val :: Char -> Int
-val c
-  | isAsciiLower c = 1 + fromEnum c - fromEnum 'a'
-  | isAsciiUpper c = 27 + fromEnum c - fromEnum 'A'
-  | otherwise = 0

day4.hs

@@ -1,34 +0,0 @@
-import Data.Char (isDigit)
-import Text.ParserCombinators.ReadP
-  ( ReadP,
-    char,
-    many1,
-    readP_to_S,
-    satisfy,
-  )
-
-main :: IO ()
-main = do
-  input <- map (fst . last . readP_to_S parse) . lines <$> readFile "day4.in"
-  putStr "Q1: "
-  print $ q1 input
-  putStr "Q2: "
-  print $ q2 input
-
-parse :: ReadP ((Int, Int), (Int, Int))
-parse = do
-  a <- readInt
-  char '-'
-  b <- readInt
-  char ','
-  c <- readInt
-  char '-'
-  d <- readInt
-  return ((a, b), (c, d))
-  where
-    readInt :: ReadP Int
-    readInt = read <$> many1 (satisfy isDigit)
-
-q1, q2 :: [((Int, Int), (Int, Int))] -> Int
-q1 = length . filter (\((a, b), (c, d)) -> a >= c && b <= d || c >= a && d <= b)
-q2 = length . filter (\((a, b), (c, d)) -> b >= c && a <= d)

day5.hs

@@ -1,44 +0,0 @@
-import Data.Char (isDigit)
-import Data.List (transpose)
-import Data.Maybe (catMaybes)
-import Text.ParserCombinators.ReadP
-
-main :: IO ()
-main = do
-  input <- lines <$> readFile "day5.in"
-  let (crates, cmds) = break null input
-  let cratesList = map catMaybes $ transpose $ map (fst . last . readP_to_S parseCrates) $ init crates
-  let cmdsList = map ((\(n, a, b) -> (n, a - 1, b - 1)) . fst . last . readP_to_S parseCmd) $ tail cmds
-  print cratesList
-  putStr "Q1: "
-  print $ q1 cratesList cmdsList
-  putStr "Q2: "
-  print $ q2 cratesList cmdsList
-
-q1, q2 :: [[Char]] -> [(Int, Int, Int)] -> [Char]
-q1 crates cmds = map head $ foldl (\x xs -> moveCrates x xs True) crates cmds
-q2 crates cmds = map head $ foldl (\x xs -> moveCrates x xs False) crates cmds
-
--- Computers are fast, really, not optimising right now
-moveCrates :: [[Char]] -> (Int, Int, Int) -> Bool -> [[Char]]
-moveCrates crates (n, a, b) rev =
-  let (head, tail) = splitAt n $ crates !! a
-   in replace b (replace a crates tail) ((if rev then reverse head else head) ++ crates !! b)
-  where
-    replace :: Int -> [a] -> a -> [a]
-    replace i xs x = take i xs ++ [x] ++ drop (i + 1) xs
-
-parseCrates :: ReadP [Maybe Char]
-parseCrates = sepBy parseRow (char ' ')
-  where
-    parseRow :: ReadP (Maybe Char)
-    parseRow = (Just <$> (char '[' *> get <* char ']')) +++ (Nothing <$ string "   ")
-
-parseCmd :: ReadP (Int, Int, Int)
-parseCmd =
-  (,,) <$> (string "move " *> getInt)
-    <*> (string " from " *> getInt)
-    <*> (string " to " *> getInt)
-  where
-    getInt :: ReadP Int
-    getInt = read <$> many1 (satisfy isDigit)

day6.hs

@@ -1,21 +0,0 @@
-import Data.List (nub)
-
-main :: IO ()
-main = do
-  input <- readFile "day6.in"
-  putStr "Q1: "
-  print $ q1 input
-  putStr "Q2: "
-  print $ q2 input
-
-q1, q2 :: String -> Int
-q1 = length . parse 4
-q2 = length . parse 14
-
-parse :: Int -> String -> String
-parse n a = parse' n (splitAt n a)
-
-parse' :: Int -> (String, String) -> String
-parse' n (a, b)
-  | length (nub (drop (length a - n) a)) == n = a
-  | otherwise = parse' n (a ++ [head b], tail b)