Day 5

4 files changed, 663 insertions, 0 deletions

diff --git a/Day5/CHANGELOG.md b/Day5/CHANGELOG.md
new file mode 100644
index 0000000..6fa5782
--- /dev/null
+++ b/Day5/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for Day5
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/Day5/Day5.cabal b/Day5/Day5.cabal
new file mode 100644
index 0000000..fb72fde
--- /dev/null
+++ b/Day5/Day5.cabal
@@ -0,0 +1,34 @@
+cabal-version:      2.4
+name:               Day5
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author:             Andreas Grois
+maintainer:         andi@grois.info
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+executable Day5
+    main-is:          Main.hs
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:    base ^>=4.16.3.0
+    hs-source-dirs:   app
+    default-language: Haskell2010
diff --git a/Day5/app/Main.hs b/Day5/app/Main.hs
new file mode 100644
index 0000000..86dce90
--- /dev/null
+++ b/Day5/app/Main.hs
@@ -0,0 +1,110 @@
+module Main (main) where
+
+import System.Environment ( getArgs )
+import Data.Bifunctor (first, second)
+
+main :: IO ()
+main = getArgs >>= readFile . head >>= print . solveDay5
+
+solveDay5 :: String -> String
+solveDay5 input = solveDay5Part1 x ++ ", " ++ solveDay5Part2 x
+    where x = parseDay5Input input
+
+data Day5Input = Day5Input {
+    state :: Stacks,
+    commands :: Commands
+}
+
+newtype Stack = Stack [Char]
+newtype Stacks = Stacks [Stack] -- Encoding: First element is topmost crate.
+
+-- Destructure Stacks
+unStacks :: Stacks -> [Stack]
+unStacks (Stacks x) = x
+
+newtype Commands = Commands [Command]
+
+data Command = Move {
+    amount :: Int,
+    source :: Int,
+    destination :: Int
+}
+
+parseDay5Input :: String -> Day5Input
+parseDay5Input input = Day5Input { state = parseStacks x, commands = parseCommands y}
+    where (x,y) = separateStacksFromCommands $ lines input
+
+separateStacksFromCommands :: [String] -> ([String],[String])
+separateStacksFromCommands ([]:bs) = ([],bs)
+separateStacksFromCommands (a:as) = Data.Bifunctor.first (a:) $ separateStacksFromCommands as
+
+-- let's fill the data from bottom to top.
+parseStacks :: [String] -> Stacks
+parseStacks = foldl addStackLine (Stacks []) . drop 1 . reverse
+
+addStackLine :: Stacks -> String -> Stacks
+addStackLine s (' ':'[':a:']':as) = addStackLine s ('[':a:']':as)
+addStackLine (Stacks (s:ss)) (' ':' ':' ':' ':as) = Stacks (s : unStacks (addStackLine (Stacks ss) as))
+addStackLine (Stacks (s:ss)) (' ':' ':' ':as) = Stacks (s : unStacks (addStackLine (Stacks ss) as))
+addStackLine (Stacks (s:ss)) ('[':a:']':as) = Stacks (addToStack s a : unStacks (addStackLine (Stacks ss) as))
+    where addToStack (Stack s) a = Stack (a:s)
+addStackLine (Stacks []) ('[':a:']':as) = Stacks (Stack [a] : unStacks (addStackLine (Stacks []) as))
+addStackLine s [] = s
+addStackLine _ s = error ("Malformed input" ++ s)
+-- With malformed input, there would be patterns we won't catch. But our input is well-formed.
+
+parseCommands :: [String] -> Commands
+parseCommands = Commands . map parseCommand
+
+parseCommand :: String -> Command
+parseCommand = parseWordedCommand . words
+    where parseWordedCommand ("move":details) = parseMove details
+              where parseMove [count, "from", origin, "to", target] = Move {amount = read count, source = read origin, destination = read target}
+          parseWordedCommand _ = error "Unsupported Command."
+
+solveDay5Part1 :: Day5Input -> String
+solveDay5Part1 Day5Input {state = state, commands = Commands c} = printTops $ foldl (flip applyCommand) state c
+
+applyCommand :: Command -> Stacks -> Stacks
+applyCommand (Move 1 source destination) = moveSingle source destination
+applyCommand (Move amount source destination) = applyCommand (Move (amount-1) source destination) . moveSingle source destination
+
+moveSingle :: Int -> Int -> Stacks -> Stacks
+moveSingle from to = placeCrate to . takeCrate from
+
+placeCrate :: Int -> (Char, Stacks) -> Stacks
+placeCrate 1 (crate, Stacks ((Stack s):ss)) = Stacks (Stack (crate:s):ss)
+placeCrate n (crate, Stacks (s:ss)) = Stacks $ s : unStacks (placeCrate (n-1) (crate, Stacks ss))
+
+takeCrate :: Int -> Stacks -> (Char, Stacks)
+takeCrate 1 (Stacks ((Stack (s:ss)):sss)) = (s, Stacks (Stack ss:sss))
+takeCrate n (Stacks (Stack s:ss)) | n > 1 = second (\x -> Stacks (Stack s:unStacks x)) (takeCrate (n-1) (Stacks ss))
+-- Should maybe add this to all take/place?
+-- takeCrate _ (Stacks []) = error "Index for Take is out of bounds."
+-- takeCrate 1 (Stacks ((Stack []):sss)) = error "Attempted to take a crate from an empty stockpile."
+-- takeCrate n _ | n < 1 = error "Index for Take is out of bounds."
+
+printTops :: Stacks -> String
+printTops (Stacks s) = foldr ((:) . getTop) "" s
+
+getTop :: Stack -> Char
+getTop (Stack s) = head s
+
+solveDay5Part2 :: Day5Input -> String
+solveDay5Part2 Day5Input {state = state, commands = Commands c} = printTops $ foldl (flip applyCommandNewerCrane) state c
+
+applyCommandNewerCrane :: Command -> Stacks -> Stacks
+applyCommandNewerCrane (Move amount source destination) = moveMany amount source destination
+
+moveMany :: Int -> Int -> Int -> Stacks -> Stacks
+moveMany count from to = placeMany to . takeMany count from
+
+placeMany :: Int -> (Stack, Stacks) -> Stacks
+placeMany 1 (Stack crates, Stacks ((Stack s):ss)) = Stacks (Stack (crates ++ s):ss)
+placeMany from (crates, Stacks (s:ss)) = Stacks $ s : unStacks (placeMany (from-1) (crates, Stacks ss))
+
+takeMany :: Int -> Int -> Stacks -> (Stack, Stacks)
+takeMany count 1 (Stacks ((Stack s):ss)) = (Stack taken,Stacks (Stack rest:ss))
+    where taken = take count s
+          rest = drop count s
+takeMany count n (Stacks (Stack s:ss)) = second (\x -> Stacks (Stack s:unStacks x)) (takeMany count (n-1) (Stacks ss))
\ No newline at end of file
diff --git a/Day5/input b/Day5/input
new file mode 100644
index 0000000..8d7a981
--- /dev/null
+++ b/Day5/input
@@ -0,0 +1,514 @@
+        [G]         [D]     [Q]    
+[P]     [T]         [L] [M] [Z]    
+[Z] [Z] [C]         [Z] [G] [W]    
+[M] [B] [F]         [P] [C] [H] [N]
+[T] [S] [R]     [H] [W] [R] [L] [W]
+[R] [T] [Q] [Z] [R] [S] [Z] [F] [P]
+[C] [N] [H] [R] [N] [H] [D] [J] [Q]
+[N] [D] [M] [G] [Z] [F] [W] [S] [S]
+ 1   2   3   4   5   6   7   8   9 
+
+move 7 from 6 to 8
+move 5 from 2 to 6
+move 2 from 4 to 1
+move 1 from 4 to 5
+move 5 from 7 to 6
+move 7 from 6 to 3
+move 5 from 9 to 2
+move 6 from 2 to 3
+move 2 from 7 to 9
+move 20 from 3 to 1
+move 11 from 1 to 6
+move 1 from 9 to 8
+move 3 from 8 to 2
+move 8 from 1 to 5
+move 10 from 8 to 4
+move 7 from 6 to 4
+move 1 from 8 to 3
+move 8 from 1 to 7
+move 16 from 4 to 8
+move 1 from 9 to 8
+move 1 from 5 to 2
+move 4 from 7 to 4
+move 5 from 6 to 7
+move 1 from 6 to 1
+move 8 from 7 to 4
+move 1 from 6 to 9
+move 12 from 4 to 5
+move 3 from 2 to 5
+move 1 from 6 to 2
+move 1 from 3 to 7
+move 1 from 3 to 2
+move 1 from 9 to 3
+move 1 from 7 to 8
+move 1 from 7 to 5
+move 1 from 3 to 2
+move 4 from 5 to 7
+move 5 from 5 to 7
+move 1 from 4 to 3
+move 1 from 3 to 9
+move 3 from 1 to 8
+move 1 from 9 to 1
+move 2 from 2 to 1
+move 2 from 2 to 7
+move 8 from 8 to 1
+move 3 from 5 to 2
+move 8 from 7 to 5
+move 7 from 1 to 3
+move 3 from 1 to 7
+move 1 from 1 to 5
+move 1 from 3 to 7
+move 7 from 5 to 8
+move 2 from 2 to 8
+move 1 from 3 to 2
+move 1 from 2 to 4
+move 1 from 4 to 8
+move 13 from 8 to 1
+move 13 from 5 to 9
+move 2 from 5 to 2
+move 7 from 9 to 3
+move 12 from 8 to 3
+move 4 from 9 to 3
+move 1 from 3 to 4
+move 2 from 2 to 3
+move 1 from 1 to 6
+move 1 from 2 to 3
+move 1 from 5 to 9
+move 7 from 7 to 4
+move 10 from 1 to 8
+move 1 from 1 to 4
+move 1 from 9 to 5
+move 2 from 5 to 1
+move 1 from 6 to 5
+move 3 from 8 to 9
+move 5 from 4 to 3
+move 4 from 4 to 1
+move 7 from 1 to 6
+move 2 from 5 to 7
+move 35 from 3 to 4
+move 4 from 9 to 1
+move 19 from 4 to 8
+move 1 from 7 to 6
+move 1 from 9 to 2
+move 10 from 4 to 5
+move 2 from 4 to 7
+move 3 from 4 to 3
+move 1 from 2 to 8
+move 1 from 1 to 9
+move 3 from 3 to 6
+move 4 from 8 to 6
+move 4 from 5 to 2
+move 2 from 8 to 3
+move 3 from 5 to 9
+move 12 from 6 to 1
+move 8 from 8 to 6
+move 2 from 9 to 1
+move 1 from 4 to 1
+move 1 from 3 to 8
+move 3 from 7 to 8
+move 2 from 9 to 7
+move 1 from 6 to 7
+move 10 from 6 to 8
+move 4 from 2 to 5
+move 1 from 3 to 7
+move 7 from 5 to 7
+move 13 from 8 to 1
+move 29 from 1 to 4
+move 8 from 7 to 8
+move 1 from 1 to 3
+move 3 from 7 to 6
+move 1 from 1 to 9
+move 15 from 4 to 1
+move 1 from 3 to 6
+move 10 from 1 to 6
+move 10 from 6 to 7
+move 1 from 4 to 9
+move 1 from 9 to 1
+move 1 from 9 to 7
+move 6 from 7 to 8
+move 1 from 1 to 6
+move 5 from 6 to 5
+move 21 from 8 to 9
+move 5 from 1 to 9
+move 2 from 9 to 5
+move 3 from 5 to 6
+move 3 from 7 to 9
+move 4 from 4 to 6
+move 6 from 8 to 7
+move 6 from 6 to 3
+move 2 from 7 to 9
+move 1 from 7 to 2
+move 6 from 3 to 2
+move 1 from 6 to 4
+move 4 from 5 to 9
+move 1 from 4 to 5
+move 9 from 4 to 6
+move 7 from 6 to 4
+move 10 from 9 to 2
+move 5 from 7 to 5
+move 10 from 2 to 7
+move 2 from 5 to 4
+move 2 from 5 to 9
+move 4 from 9 to 4
+move 1 from 8 to 6
+move 7 from 7 to 2
+move 1 from 5 to 4
+move 2 from 7 to 1
+move 1 from 5 to 7
+move 3 from 6 to 2
+move 4 from 4 to 5
+move 1 from 2 to 7
+move 10 from 4 to 7
+move 3 from 7 to 3
+move 17 from 9 to 4
+move 1 from 1 to 4
+move 1 from 1 to 5
+move 5 from 2 to 7
+move 1 from 9 to 2
+move 5 from 4 to 8
+move 2 from 9 to 7
+move 4 from 8 to 1
+move 3 from 4 to 8
+move 1 from 2 to 5
+move 1 from 9 to 2
+move 6 from 4 to 8
+move 3 from 7 to 5
+move 1 from 4 to 9
+move 1 from 9 to 1
+move 3 from 1 to 9
+move 4 from 8 to 5
+move 2 from 9 to 8
+move 4 from 2 to 5
+move 8 from 7 to 2
+move 5 from 8 to 5
+move 2 from 7 to 8
+move 1 from 3 to 5
+move 1 from 1 to 2
+move 1 from 1 to 6
+move 2 from 3 to 6
+move 5 from 2 to 8
+move 4 from 7 to 1
+move 7 from 8 to 5
+move 1 from 1 to 5
+move 3 from 8 to 3
+move 1 from 9 to 3
+move 7 from 2 to 3
+move 2 from 2 to 8
+move 2 from 4 to 8
+move 1 from 8 to 5
+move 1 from 1 to 4
+move 2 from 4 to 7
+move 2 from 7 to 1
+move 3 from 2 to 3
+move 3 from 5 to 2
+move 1 from 8 to 3
+move 3 from 3 to 2
+move 5 from 2 to 1
+move 17 from 5 to 8
+move 9 from 8 to 1
+move 11 from 3 to 5
+move 8 from 8 to 5
+move 2 from 8 to 5
+move 16 from 1 to 4
+move 13 from 4 to 7
+move 6 from 5 to 2
+move 2 from 4 to 8
+move 5 from 7 to 9
+move 2 from 1 to 2
+move 7 from 7 to 1
+move 1 from 1 to 4
+move 1 from 9 to 8
+move 7 from 2 to 8
+move 1 from 4 to 7
+move 2 from 9 to 4
+move 1 from 4 to 1
+move 1 from 3 to 5
+move 2 from 9 to 8
+move 11 from 8 to 7
+move 2 from 6 to 5
+move 1 from 6 to 9
+move 1 from 1 to 9
+move 1 from 9 to 1
+move 4 from 1 to 4
+move 2 from 1 to 8
+move 1 from 1 to 2
+move 1 from 9 to 5
+move 2 from 4 to 3
+move 2 from 2 to 7
+move 2 from 3 to 9
+move 1 from 9 to 1
+move 1 from 9 to 1
+move 5 from 5 to 1
+move 19 from 5 to 6
+move 5 from 1 to 4
+move 1 from 2 to 9
+move 1 from 1 to 3
+move 7 from 5 to 8
+move 1 from 3 to 6
+move 8 from 7 to 3
+move 7 from 4 to 8
+move 3 from 8 to 5
+move 1 from 4 to 1
+move 1 from 9 to 4
+move 1 from 4 to 9
+move 1 from 5 to 2
+move 2 from 5 to 6
+move 2 from 8 to 2
+move 7 from 8 to 1
+move 1 from 1 to 7
+move 3 from 6 to 9
+move 2 from 3 to 2
+move 1 from 2 to 1
+move 1 from 8 to 7
+move 2 from 9 to 6
+move 2 from 9 to 5
+move 1 from 5 to 6
+move 1 from 2 to 8
+move 2 from 1 to 7
+move 1 from 4 to 3
+move 3 from 2 to 5
+move 7 from 1 to 3
+move 10 from 3 to 4
+move 3 from 5 to 4
+move 1 from 3 to 8
+move 3 from 3 to 2
+move 1 from 8 to 1
+move 1 from 1 to 3
+move 3 from 8 to 3
+move 5 from 4 to 6
+move 1 from 2 to 3
+move 4 from 6 to 4
+move 1 from 5 to 7
+move 4 from 3 to 4
+move 1 from 2 to 8
+move 12 from 7 to 6
+move 1 from 8 to 2
+move 2 from 2 to 7
+move 1 from 8 to 4
+move 23 from 6 to 3
+move 14 from 3 to 6
+move 15 from 4 to 6
+move 1 from 8 to 6
+move 10 from 3 to 7
+move 2 from 4 to 2
+move 11 from 7 to 8
+move 2 from 2 to 6
+move 44 from 6 to 9
+move 21 from 9 to 3
+move 12 from 3 to 6
+move 1 from 7 to 4
+move 1 from 4 to 7
+move 9 from 3 to 2
+move 2 from 8 to 6
+move 3 from 2 to 4
+move 17 from 9 to 1
+move 3 from 4 to 6
+move 2 from 2 to 9
+move 4 from 9 to 2
+move 10 from 6 to 9
+move 1 from 7 to 6
+move 4 from 9 to 5
+move 4 from 2 to 4
+move 14 from 1 to 5
+move 4 from 4 to 3
+move 3 from 2 to 9
+move 9 from 9 to 7
+move 1 from 2 to 5
+move 9 from 8 to 5
+move 8 from 7 to 2
+move 4 from 3 to 8
+move 5 from 6 to 2
+move 3 from 1 to 6
+move 1 from 7 to 1
+move 4 from 2 to 4
+move 3 from 6 to 4
+move 3 from 8 to 3
+move 13 from 5 to 2
+move 2 from 3 to 5
+move 12 from 5 to 9
+move 1 from 3 to 5
+move 1 from 5 to 9
+move 1 from 8 to 3
+move 4 from 9 to 5
+move 6 from 4 to 5
+move 12 from 9 to 7
+move 1 from 9 to 3
+move 1 from 3 to 2
+move 12 from 5 to 6
+move 12 from 7 to 2
+move 1 from 3 to 7
+move 1 from 4 to 8
+move 33 from 2 to 8
+move 1 from 7 to 5
+move 1 from 1 to 2
+move 4 from 5 to 4
+move 3 from 2 to 5
+move 34 from 8 to 6
+move 1 from 4 to 3
+move 1 from 5 to 7
+move 1 from 7 to 5
+move 3 from 4 to 9
+move 2 from 9 to 7
+move 1 from 9 to 4
+move 1 from 3 to 7
+move 1 from 5 to 8
+move 1 from 5 to 1
+move 1 from 5 to 7
+move 1 from 4 to 8
+move 1 from 1 to 4
+move 1 from 4 to 2
+move 3 from 7 to 5
+move 2 from 8 to 5
+move 1 from 2 to 8
+move 4 from 6 to 2
+move 1 from 8 to 6
+move 1 from 7 to 9
+move 29 from 6 to 7
+move 4 from 2 to 3
+move 2 from 5 to 8
+move 1 from 9 to 5
+move 2 from 8 to 1
+move 23 from 7 to 5
+move 2 from 6 to 1
+move 23 from 5 to 6
+move 1 from 3 to 6
+move 4 from 5 to 9
+move 2 from 1 to 3
+move 5 from 3 to 8
+move 2 from 6 to 5
+move 2 from 1 to 4
+move 1 from 9 to 8
+move 1 from 9 to 1
+move 1 from 4 to 6
+move 2 from 5 to 6
+move 6 from 7 to 8
+move 2 from 9 to 2
+move 18 from 6 to 5
+move 21 from 6 to 4
+move 1 from 1 to 6
+move 2 from 6 to 7
+move 2 from 7 to 9
+move 2 from 2 to 8
+move 7 from 4 to 3
+move 12 from 5 to 3
+move 1 from 9 to 5
+move 1 from 9 to 4
+move 6 from 5 to 2
+move 17 from 3 to 4
+move 3 from 4 to 3
+move 1 from 2 to 4
+move 5 from 2 to 8
+move 1 from 5 to 8
+move 19 from 8 to 7
+move 1 from 3 to 6
+move 1 from 8 to 4
+move 1 from 6 to 1
+move 15 from 4 to 6
+move 1 from 1 to 4
+move 3 from 3 to 5
+move 4 from 6 to 7
+move 1 from 4 to 7
+move 10 from 6 to 7
+move 16 from 4 to 5
+move 24 from 7 to 2
+move 8 from 7 to 8
+move 1 from 4 to 2
+move 6 from 8 to 7
+move 1 from 8 to 7
+move 1 from 6 to 9
+move 14 from 5 to 4
+move 9 from 7 to 8
+move 4 from 5 to 1
+move 2 from 1 to 5
+move 3 from 8 to 6
+move 2 from 6 to 9
+move 2 from 2 to 8
+move 6 from 2 to 7
+move 3 from 4 to 6
+move 1 from 3 to 4
+move 3 from 5 to 7
+move 1 from 6 to 9
+move 5 from 7 to 2
+move 4 from 9 to 1
+move 1 from 7 to 9
+move 9 from 8 to 4
+move 5 from 1 to 2
+move 2 from 6 to 1
+move 6 from 4 to 7
+move 1 from 7 to 3
+move 1 from 3 to 9
+move 1 from 9 to 7
+move 1 from 6 to 7
+move 9 from 4 to 5
+move 7 from 7 to 9
+move 3 from 7 to 5
+move 1 from 9 to 2
+move 6 from 9 to 8
+move 4 from 4 to 5
+move 1 from 4 to 2
+move 1 from 4 to 2
+move 2 from 1 to 2
+move 1 from 9 to 8
+move 10 from 2 to 4
+move 8 from 2 to 7
+move 12 from 2 to 9
+move 6 from 7 to 4
+move 1 from 1 to 2
+move 8 from 9 to 8
+move 7 from 5 to 1
+move 9 from 4 to 3
+move 14 from 8 to 4
+move 1 from 8 to 4
+move 1 from 1 to 5
+move 1 from 5 to 2
+move 3 from 2 to 4
+move 1 from 7 to 1
+move 1 from 7 to 3
+move 2 from 1 to 7
+move 3 from 5 to 7
+move 2 from 7 to 6
+move 1 from 6 to 5
+move 3 from 7 to 1
+move 1 from 6 to 8
+move 1 from 8 to 7
+move 1 from 3 to 6
+move 1 from 7 to 1
+move 4 from 1 to 4
+move 6 from 3 to 2
+move 3 from 1 to 2
+move 3 from 3 to 6
+move 3 from 2 to 6
+move 6 from 6 to 5
+move 1 from 1 to 4
+move 1 from 9 to 6
+move 5 from 2 to 1
+move 3 from 1 to 2
+move 2 from 9 to 8
+move 3 from 1 to 5
+move 1 from 9 to 7
+move 25 from 4 to 1
+move 1 from 1 to 7
+move 2 from 8 to 3
+move 13 from 1 to 9
+move 2 from 3 to 5
+move 8 from 5 to 9
+move 4 from 2 to 1
+move 2 from 6 to 7
+move 10 from 5 to 9
+move 4 from 7 to 2
+move 2 from 2 to 3
+move 9 from 9 to 2
+move 4 from 4 to 5
+move 4 from 5 to 4
+move 5 from 1 to 4
+move 10 from 4 to 5
+move 22 from 9 to 1
+move 2 from 2 to 7
+move 3 from 2 to 1
+move 6 from 2 to 6
+move 1 from 7 to 1
+move 10 from 5 to 7
+move 15 from 1 to 4
+move 13 from 1 to 5
+move 3 from 6 to 8
+move 1 from 8 to 9