day 5: complete rewrite

use Data.Text and Data.Map

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

.envrc

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

day5.hs

@@ -1,44 +1,44 @@
-import Data.Char (isDigit)
+{-# LANGUAGE OverloadedStrings #-}
-import Data.List (transpose)
+{-# LANGUAGE ViewPatterns #-}
-import Data.Maybe (catMaybes)
+
-import Text.ParserCombinators.ReadP
+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 <- lines <$> readFile "day5.in"
+  input <- break (== T.empty) . T.lines <$> readFile' "day5.in"
-  let (crates, cmds) = break null input
+  let (crates, cmds) = parse 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
+  print $ moveCrates T.reverse crates cmds
   putStr "Q2: "
-  print $ q2 cratesList cmdsList
+  print $ moveCrates id crates cmds
 
-q1, q2 :: [[Char]] -> [(Int, Int, Int)] -> [Char]
+moveCrates :: (Text -> Text) -> [Text] -> [(Int, Int, Int)] -> Text
-q1 crates cmds = map head $ foldl (\x xs -> moveCrates x xs True) crates cmds
+moveCrates f crates' cmds = head . T.transpose . M.elems $ foldl' move 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]
+    crates :: Map Int Text
-    replace i xs x = take i xs ++ [x] ++ drop (i + 1) xs
+    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
 
-parseCrates :: ReadP [Maybe Char]
+-- ugly code vs line length <= 90 🤔
-parseCrates = sepBy parseRow (char ' ')
+parse :: ([Text], [Text]) -> ([Text], [(Int, Int, Int)])
-  where
+parse (crates, cmds) =
-    parseRow :: ReadP (Maybe Char)
+  ( [ T.filter (/= ' ') x
-    parseRow = (Just <$> (char '[' *> get <* char ']')) +++ (Nothing <$ string "   ")
+      | (i, x) <- zip [0 ..] (T.transpose $ init crates),
-
+        i `mod` 4 == 1
-parseCmd :: ReadP (Int, Int, Int)
+    ],
-parseCmd =
+    map
-  (,,) <$> (string "move " *> getInt)
+      ( ( \["move", T.unpack -> n, "from", T.unpack -> x, "to", T.unpack -> y] ->
-    <*> (string " from " *> getInt)
+            (read n, read x - 1, read y - 1)
-    <*> (string " to " *> getInt)
+        )
-  where
+          . T.words
-    getInt :: ReadP Int
+      )
-    getInt = read <$> many1 (satisfy isDigit)
+      $ tail cmds
+  )