Day 5 Part 2

05/Main.idr

@@ -0,0 +1,153 @@
+import System.File.ReadWrite
+import Data.List
+import Data.String
+
+data Crate = C Char
+
+Show Crate where
+  show (C c) = pack ['[', c, ']']
+
+parseCrate : String -> Maybe Crate
+parseCrate str = let str = unpack str in
+                 case str of
+                   ('[' :: x :: ']' :: _) => Just (C x)
+                   _ => Nothing
+
+data Stacks = Stks (List (List Crate))
+
+Show Stacks where
+  show (Stks stacks) =
+    let longestStack = foldl max 0 . map length $ stacks
+        stringStacks = map (extendFront longestStack "   ") . map (map show) $ stacks
+        lastLine = unwords . map (\x => " " ++ x ++ " ") . map show $ rangeFromTo 1 (length stacks)
+        lineStacks = filter (/= "") . map unwords . transposeList longestStack $ stringStacks
+    in joinBy "\n" $ (lineStacks ++ [lastLine])
+    where extendFront : Nat -> a -> List a -> List a
+          extendFront k x xs =
+            if length xs < k
+            then replicate (minus k (length xs)) x ++ xs
+            else xs
+          transposeList : Nat -> List (List a) -> List (List a)
+          transposeList k xs =
+            if any isNil xs
+            then replicate k []
+            else let firsts = map (take 1) xs
+                     rests = map (drop 1) xs
+                 in foldl (++) [] firsts :: transposeList k (assert_smaller xs rests)
+
+-- Chunk up a list
+chunk : Nat -> List a -> List (List a)
+chunk k [] = []
+chunk k xs = let (head, tail) = splitAt k xs in
+             head :: chunk k tail
+
+-- Ensure a list of maybes is at least a specific length
+ensureLen : Nat -> List (Maybe a) -> List (Maybe a)
+ensureLen k [] = replicate k Nothing
+ensureLen 0 xs = xs
+ensureLen (S k) (x :: xs) = x :: ensureLen k xs
+
+-- Parse a list of stacks, this should be passed a list of lines including the line of numbers
+parseStacks : Nat -> List String -> Stacks
+parseStacks k [] = Stks $ replicate k []
+parseStacks k (x :: []) = parseStacks k []
+parseStacks k (x :: xs) = let (Stks bottom) = parseStacks k xs
+                              row = ensureLen k . map parseCrate . map pack . chunk 4 . unpack $ x
+                          in Stks $ zipWith parseStacksHelper row bottom
+  where parseStacksHelper : Maybe Crate -> List Crate -> List Crate
+        parseStacksHelper (Just crate) xs = crate :: xs
+        parseStacksHelper Nothing xs = xs
+
+-- Get the tops of each stack
+tops : Stacks -> String
+tops (Stks xss) = pack . map (\(C c) => c) . catMaybes . map head' $ xss
+
+simple : String
+simple = """
+      [D]
+  [N] [C]
+  [Z] [M] [P]
+  1   2   3
+
+  move 1 from 2 to 1
+  move 3 from 1 to 3
+  move 2 from 2 to 1
+  move 1 from 1 to 2
+  """
+data Command = Cmd Nat Nat Nat
+
+Show Command where
+  show (Cmd x y z) = (show x) ++ " " ++ (show (y + 1)) ++ "->" ++ (show (z + 1))
+
+-- Parse a command
+parseCommand : String -> Maybe Command
+parseCommand str =
+  let nums : List Nat
+      nums = catMaybes . map parsePositive . words $ str
+  in case nums of
+        [x, y, z] => Just (Cmd x (minus y 1) (minus z 1))
+        _ => Nothing
+
+-- Apply a command to the stacks
+applyCommand : Command -> Bool -> Stacks -> Maybe Stacks
+applyCommand (Cmd count from to) multiple stacks =
+  do (crates, removed) <- extractCrates count from stacks
+     addCrates (if multiple then crates else reverse crates) to removed
+  where extractCrates : Nat -> Nat -> Stacks -> Maybe ((List Crate), Stacks)
+        extractCrates count from (Stks []) = Nothing
+        extractCrates count 0 (Stks (x :: xs)) =
+          if count > length x
+          then Nothing
+          else let (taken, rest) = splitAt count x in
+               Just (taken, Stks (rest :: xs))
+        extractCrates count (S k) (Stks (x :: xs)) =
+          do (c, (Stks s)) <- extractCrates count k (Stks xs)
+             Just (c, (Stks (x :: s)))
+        addCrates : List Crate -> Nat -> Stacks -> Maybe Stacks
+        addCrates xs to (Stks []) = Nothing
+        addCrates xs 0 (Stks (x :: ys)) = Just (Stks ((xs ++ x) :: ys))
+        addCrates xs (S k) (Stks (x :: ys)) =
+          do (Stks added) <- addCrates xs k (Stks ys)
+             Just (Stks (x :: added))
+
+data CmdResult = CR Bool (Maybe Command) Stacks
+
+Show CmdResult where
+  show (CR bool command stacks) =
+    unlines ["Command applied: " ++ (show bool), "Command: " ++ (show command), show stacks]
+
+-- Apply a list of commands to a stacks
+applyCommands : List Command -> Bool -> Stacks -> List CmdResult
+applyCommands [] multiple x = [CR False Nothing x]
+applyCommands (y :: xs) multiple x =
+  case applyCommand y multiple x of
+    Just stacks => CR True (Just y) stacks :: applyCommands xs multiple stacks
+    Nothing => [CR False (Just y) x]
+
+mapM : Monad m => (a -> m b) -> List a -> m (List b)
+mapM f [] = pure []
+mapM f (x :: xs) =
+  do x <- f x
+     rest <- mapM f xs
+     pure $ x :: rest
+
+partial unwrap : Maybe a -> a
+unwrap (Just x) = x
+
+partial main : IO ()
+main =
+ do file <- readFile "input"
+    case file of
+      Right content =>
+        let stacks = parseStacks 9 . takeWhile (/= "") . lines $ content
+            commands = catMaybes . map parseCommand . drop 1 . dropWhile (/= "") . lines $ content
+            part1 = unwrap . map (\(CR _ _ stacks) => tops stacks) . last' . applyCommands commands False $ stacks
+            part2 = unwrap . map (\(CR _ _ stacks) => tops stacks) . last' . applyCommands commands True $ stacks
+        in do putStrLn "Input: "
+              printLn stacks
+              putStrLn " "
+              putStr "Part 1: "
+              putStrLn part1
+              putStr "Part 2: "
+              putStrLn part2
+      Left err => printLn err

05/input

@@ -0,0 +1,515 @@
+            [G] [W]         [Q]    
+[Z]         [Q] [M]     [J] [F]    
+[V]         [V] [S] [F] [N] [R]    
+[T]         [F] [C] [H] [F] [W] [P]
+[B] [L]     [L] [J] [C] [V] [D] [V]
+[J] [V] [F] [N] [T] [T] [C] [Z] [W]
+[G] [R] [Q] [H] [Q] [W] [Z] [G] [B]
+[R] [J] [S] [Z] [R] [S] [D] [L] [J]
+ 1   2   3   4   5   6   7   8   9 
+
+move 6 from 5 to 7
+move 2 from 9 to 1
+move 4 from 8 to 6
+move 1 from 8 to 1
+move 2 from 9 to 1
+move 1 from 6 to 1
+move 13 from 7 to 8
+move 1 from 2 to 8
+move 9 from 1 to 5
+move 1 from 3 to 8
+move 3 from 6 to 7
+move 4 from 4 to 1
+move 11 from 5 to 6
+move 6 from 6 to 9
+move 3 from 4 to 2
+move 7 from 8 to 6
+move 1 from 7 to 5
+move 1 from 4 to 3
+move 7 from 1 to 5
+move 2 from 2 to 7
+move 4 from 9 to 6
+move 1 from 3 to 6
+move 1 from 1 to 9
+move 1 from 3 to 6
+move 1 from 5 to 8
+move 4 from 6 to 7
+move 3 from 8 to 7
+move 7 from 5 to 7
+move 1 from 3 to 1
+move 1 from 2 to 6
+move 14 from 6 to 5
+move 2 from 5 to 2
+move 3 from 9 to 2
+move 6 from 2 to 9
+move 7 from 8 to 6
+move 7 from 7 to 3
+move 2 from 8 to 7
+move 6 from 3 to 7
+move 17 from 7 to 1
+move 1 from 3 to 1
+move 1 from 2 to 5
+move 4 from 5 to 6
+move 17 from 6 to 9
+move 7 from 9 to 4
+move 1 from 2 to 7
+move 2 from 5 to 4
+move 3 from 7 to 8
+move 7 from 5 to 2
+move 6 from 2 to 8
+move 8 from 9 to 6
+move 1 from 2 to 3
+move 8 from 4 to 9
+move 7 from 6 to 9
+move 18 from 1 to 7
+move 1 from 1 to 8
+move 2 from 6 to 9
+move 1 from 3 to 9
+move 1 from 4 to 6
+move 1 from 8 to 3
+move 1 from 3 to 1
+move 10 from 7 to 2
+move 9 from 8 to 4
+move 1 from 6 to 4
+move 2 from 7 to 8
+move 5 from 4 to 9
+move 17 from 9 to 5
+move 2 from 7 to 6
+move 5 from 9 to 7
+move 5 from 4 to 2
+move 8 from 2 to 4
+move 8 from 4 to 3
+move 2 from 6 to 5
+move 2 from 8 to 5
+move 3 from 9 to 3
+move 4 from 7 to 3
+move 6 from 9 to 6
+move 4 from 6 to 9
+move 5 from 9 to 3
+move 8 from 5 to 2
+move 1 from 1 to 9
+move 1 from 6 to 3
+move 1 from 9 to 4
+move 5 from 7 to 4
+move 19 from 3 to 1
+move 4 from 2 to 8
+move 13 from 5 to 1
+move 1 from 6 to 3
+move 3 from 3 to 6
+move 2 from 8 to 9
+move 4 from 2 to 9
+move 2 from 2 to 6
+move 1 from 1 to 6
+move 5 from 1 to 9
+move 10 from 9 to 3
+move 15 from 1 to 6
+move 21 from 6 to 2
+move 20 from 2 to 1
+move 2 from 8 to 9
+move 28 from 1 to 2
+move 6 from 4 to 6
+move 2 from 1 to 5
+move 3 from 3 to 4
+move 2 from 5 to 4
+move 1 from 4 to 3
+move 3 from 4 to 5
+move 2 from 5 to 4
+move 1 from 1 to 8
+move 25 from 2 to 9
+move 1 from 4 to 6
+move 1 from 3 to 8
+move 4 from 3 to 6
+move 1 from 4 to 9
+move 2 from 6 to 3
+move 1 from 5 to 9
+move 5 from 2 to 8
+move 7 from 9 to 6
+move 2 from 9 to 4
+move 3 from 2 to 1
+move 3 from 3 to 4
+move 1 from 3 to 5
+move 16 from 6 to 3
+move 7 from 8 to 3
+move 5 from 4 to 3
+move 1 from 1 to 3
+move 1 from 2 to 6
+move 1 from 5 to 6
+move 21 from 3 to 5
+move 2 from 1 to 2
+move 1 from 6 to 7
+move 10 from 9 to 8
+move 1 from 6 to 5
+move 5 from 8 to 7
+move 12 from 5 to 3
+move 20 from 3 to 6
+move 4 from 7 to 9
+move 1 from 7 to 3
+move 1 from 2 to 5
+move 1 from 3 to 8
+move 2 from 8 to 4
+move 4 from 8 to 7
+move 3 from 6 to 1
+move 1 from 1 to 5
+move 2 from 9 to 2
+move 2 from 1 to 5
+move 2 from 5 to 6
+move 3 from 7 to 1
+move 2 from 1 to 4
+move 4 from 6 to 8
+move 3 from 4 to 7
+move 3 from 2 to 5
+move 2 from 7 to 9
+move 9 from 9 to 8
+move 1 from 4 to 1
+move 7 from 5 to 7
+move 1 from 7 to 8
+move 1 from 3 to 1
+move 4 from 7 to 5
+move 2 from 1 to 9
+move 1 from 1 to 2
+move 5 from 5 to 4
+move 1 from 2 to 6
+move 5 from 7 to 9
+move 5 from 4 to 7
+move 11 from 9 to 6
+move 14 from 8 to 9
+move 23 from 6 to 5
+move 6 from 9 to 5
+move 1 from 6 to 2
+move 10 from 5 to 3
+move 1 from 4 to 9
+move 1 from 2 to 1
+move 2 from 7 to 3
+move 10 from 5 to 7
+move 8 from 5 to 2
+move 5 from 3 to 5
+move 7 from 5 to 8
+move 1 from 2 to 7
+move 9 from 7 to 9
+move 3 from 2 to 3
+move 2 from 6 to 2
+move 2 from 3 to 6
+move 4 from 7 to 5
+move 1 from 1 to 5
+move 4 from 3 to 1
+move 2 from 5 to 2
+move 1 from 3 to 2
+move 2 from 6 to 8
+move 7 from 5 to 3
+move 9 from 2 to 4
+move 2 from 1 to 2
+move 2 from 5 to 3
+move 1 from 4 to 9
+move 1 from 6 to 9
+move 1 from 4 to 2
+move 2 from 1 to 7
+move 3 from 2 to 6
+move 4 from 8 to 7
+move 2 from 8 to 3
+move 2 from 3 to 7
+move 1 from 6 to 5
+move 2 from 8 to 2
+move 5 from 4 to 1
+move 8 from 9 to 8
+move 1 from 5 to 7
+move 10 from 9 to 2
+move 8 from 8 to 2
+move 1 from 1 to 6
+move 12 from 3 to 9
+move 7 from 7 to 4
+move 13 from 2 to 4
+move 7 from 2 to 7
+move 1 from 6 to 7
+move 3 from 9 to 8
+move 2 from 6 to 3
+move 1 from 3 to 2
+move 1 from 3 to 9
+move 3 from 1 to 5
+move 1 from 1 to 6
+move 4 from 7 to 6
+move 5 from 7 to 1
+move 1 from 2 to 1
+move 6 from 9 to 4
+move 5 from 9 to 7
+move 3 from 8 to 3
+move 22 from 4 to 9
+move 24 from 9 to 8
+move 1 from 9 to 2
+move 2 from 4 to 3
+move 10 from 8 to 3
+move 1 from 2 to 1
+move 1 from 3 to 8
+move 1 from 6 to 3
+move 1 from 1 to 4
+move 4 from 3 to 4
+move 4 from 6 to 1
+move 2 from 4 to 5
+move 4 from 7 to 2
+move 7 from 4 to 6
+move 4 from 6 to 1
+move 2 from 6 to 3
+move 1 from 6 to 2
+move 5 from 5 to 2
+move 12 from 3 to 5
+move 3 from 7 to 8
+move 6 from 2 to 3
+move 11 from 1 to 9
+move 1 from 1 to 7
+move 1 from 7 to 5
+move 2 from 3 to 9
+move 2 from 9 to 7
+move 4 from 2 to 5
+move 2 from 7 to 1
+move 17 from 8 to 1
+move 1 from 3 to 2
+move 16 from 1 to 3
+move 8 from 3 to 4
+move 2 from 8 to 3
+move 2 from 1 to 5
+move 1 from 2 to 6
+move 12 from 5 to 8
+move 1 from 6 to 3
+move 9 from 3 to 9
+move 8 from 4 to 6
+move 2 from 1 to 6
+move 6 from 8 to 4
+move 3 from 4 to 6
+move 1 from 1 to 9
+move 11 from 6 to 8
+move 3 from 4 to 3
+move 17 from 9 to 5
+move 2 from 6 to 7
+move 1 from 9 to 1
+move 2 from 8 to 6
+move 1 from 7 to 5
+move 1 from 8 to 9
+move 1 from 1 to 7
+move 3 from 9 to 6
+move 2 from 7 to 8
+move 1 from 9 to 6
+move 15 from 5 to 2
+move 9 from 3 to 9
+move 11 from 8 to 3
+move 6 from 9 to 8
+move 4 from 6 to 7
+move 3 from 3 to 7
+move 5 from 5 to 6
+move 7 from 7 to 5
+move 3 from 6 to 1
+move 2 from 1 to 4
+move 1 from 9 to 2
+move 2 from 9 to 3
+move 2 from 6 to 3
+move 1 from 1 to 8
+move 6 from 5 to 9
+move 8 from 2 to 5
+move 10 from 8 to 5
+move 1 from 2 to 9
+move 21 from 5 to 9
+move 2 from 8 to 4
+move 5 from 9 to 1
+move 2 from 5 to 2
+move 15 from 9 to 2
+move 1 from 5 to 9
+move 9 from 9 to 3
+move 1 from 1 to 6
+move 3 from 4 to 1
+move 20 from 3 to 5
+move 20 from 5 to 4
+move 7 from 4 to 3
+move 1 from 1 to 7
+move 11 from 4 to 5
+move 4 from 3 to 2
+move 11 from 5 to 4
+move 2 from 6 to 7
+move 4 from 3 to 9
+move 2 from 2 to 8
+move 2 from 9 to 4
+move 6 from 4 to 6
+move 2 from 7 to 9
+move 1 from 7 to 6
+move 1 from 4 to 9
+move 4 from 4 to 6
+move 2 from 8 to 6
+move 1 from 4 to 3
+move 1 from 4 to 6
+move 1 from 3 to 1
+move 3 from 4 to 3
+move 9 from 2 to 8
+move 2 from 3 to 7
+move 5 from 6 to 2
+move 2 from 7 to 5
+move 1 from 5 to 2
+move 1 from 9 to 3
+move 1 from 5 to 1
+move 13 from 2 to 5
+move 4 from 9 to 5
+move 1 from 3 to 4
+move 9 from 2 to 3
+move 7 from 3 to 2
+move 11 from 5 to 6
+move 5 from 8 to 7
+move 1 from 3 to 1
+move 2 from 8 to 5
+move 2 from 8 to 1
+move 1 from 4 to 1
+move 6 from 2 to 7
+move 3 from 5 to 3
+move 1 from 2 to 5
+move 7 from 7 to 9
+move 3 from 3 to 5
+move 1 from 2 to 5
+move 2 from 3 to 2
+move 6 from 1 to 7
+move 10 from 7 to 3
+move 1 from 2 to 3
+move 6 from 9 to 8
+move 1 from 2 to 4
+move 2 from 6 to 1
+move 5 from 1 to 9
+move 8 from 5 to 8
+move 2 from 1 to 6
+move 6 from 3 to 4
+move 1 from 5 to 3
+move 4 from 9 to 6
+move 1 from 1 to 4
+move 2 from 9 to 2
+move 5 from 6 to 1
+move 11 from 6 to 7
+move 1 from 2 to 8
+move 6 from 7 to 5
+move 10 from 8 to 4
+move 2 from 3 to 9
+move 3 from 3 to 5
+move 4 from 7 to 9
+move 2 from 1 to 3
+move 10 from 5 to 8
+move 6 from 6 to 1
+move 2 from 6 to 8
+move 2 from 9 to 5
+move 4 from 9 to 6
+move 7 from 4 to 8
+move 5 from 6 to 1
+move 4 from 8 to 2
+move 2 from 5 to 6
+move 5 from 4 to 5
+move 1 from 7 to 5
+move 2 from 3 to 6
+move 1 from 3 to 8
+move 4 from 6 to 1
+move 4 from 2 to 3
+move 5 from 5 to 1
+move 2 from 3 to 2
+move 2 from 3 to 2
+move 20 from 8 to 2
+move 5 from 4 to 8
+move 1 from 4 to 3
+move 8 from 2 to 1
+move 1 from 5 to 6
+move 5 from 2 to 3
+move 1 from 6 to 5
+move 5 from 3 to 2
+move 1 from 3 to 7
+move 6 from 8 to 5
+move 13 from 2 to 9
+move 7 from 9 to 8
+move 1 from 7 to 8
+move 5 from 8 to 3
+move 2 from 2 to 5
+move 2 from 8 to 4
+move 27 from 1 to 5
+move 1 from 2 to 3
+move 5 from 3 to 1
+move 22 from 5 to 7
+move 1 from 8 to 5
+move 1 from 3 to 2
+move 7 from 1 to 3
+move 2 from 3 to 7
+move 2 from 2 to 4
+move 5 from 9 to 1
+move 5 from 3 to 9
+move 3 from 1 to 5
+move 3 from 1 to 6
+move 3 from 6 to 3
+move 4 from 4 to 2
+move 8 from 5 to 3
+move 8 from 7 to 4
+move 14 from 7 to 4
+move 1 from 1 to 7
+move 6 from 9 to 6
+move 7 from 5 to 3
+move 14 from 3 to 6
+move 2 from 2 to 1
+move 4 from 3 to 7
+move 6 from 7 to 6
+move 1 from 7 to 6
+move 1 from 5 to 1
+move 2 from 1 to 5
+move 3 from 5 to 7
+move 8 from 6 to 5
+move 5 from 5 to 1
+move 1 from 7 to 3
+move 1 from 3 to 8
+move 22 from 4 to 7
+move 7 from 6 to 3
+move 4 from 3 to 2
+move 3 from 1 to 3
+move 17 from 7 to 6
+move 1 from 8 to 1
+move 2 from 2 to 4
+move 3 from 7 to 2
+move 2 from 2 to 9
+move 1 from 1 to 8
+move 2 from 3 to 1
+move 6 from 6 to 8
+move 2 from 9 to 2
+move 4 from 5 to 1
+move 5 from 8 to 9
+move 1 from 7 to 3
+move 4 from 3 to 4
+move 1 from 7 to 4
+move 4 from 9 to 7
+move 5 from 7 to 9
+move 1 from 7 to 3
+move 2 from 2 to 8
+move 5 from 4 to 2
+move 21 from 6 to 8
+move 2 from 3 to 8
+move 23 from 8 to 6
+move 1 from 2 to 6
+move 2 from 9 to 8
+move 22 from 6 to 7
+move 2 from 9 to 3
+move 2 from 3 to 7
+move 2 from 1 to 6
+move 1 from 2 to 5
+move 3 from 1 to 3
+move 6 from 7 to 4
+move 5 from 8 to 5
+move 1 from 3 to 8
+move 1 from 9 to 3
+move 6 from 4 to 8
+move 1 from 5 to 3
+move 6 from 2 to 8
+move 15 from 7 to 5
+move 1 from 7 to 1
+move 14 from 5 to 8
+move 1 from 4 to 9
+move 5 from 1 to 7
+move 3 from 6 to 2
+move 4 from 5 to 6
+move 1 from 4 to 8
+move 4 from 3 to 1
+move 2 from 9 to 2
+move 7 from 7 to 1
+move 7 from 2 to 7
+move 9 from 8 to 6
+move 7 from 7 to 1
+move 12 from 6 to 8
+move 25 from 8 to 6
+move 3 from 8 to 1
+move 28 from 6 to 2
+move 15 from 2 to 3
+move 1 from 5 to 4
+move 3 from 2 to 7
+move 6 from 2 to 9