day 13

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

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