Day 7

1 files changed, 41 insertions, 0 deletions

diff --git a/2019/7.hs b/2019/7.hs
new file mode 100644
index 0000000..d5910f1
--- /dev/null
+++ b/2019/7.hs
@@ -0,0 +1,41 @@
+module Main where
+
+import Data.Either
+import Data.List
+
+import Input
+import IntCode
+
+
+part1 :: [Int] -> Int
+part1 program =
+    let settings = permutations [0..4]
+        outcome setting = foldr (.) id [\i -> head (snd (run program [p,i])) | p <- setting] 0
+    in maximum (map outcome settings)
+
+part2 :: [Int] -> Int
+part2 program =
+    let settings = permutations [5..9]
+        outcome setting =
+            let initConts = [let Left (cont, _) = runInterruptible program [p] in cont
+                            | p <- setting]
+                generation conts firstInp =
+                    let (output, results) = foldProduce (\inp cont ->
+                                                            let res = runContinue cont [inp]
+                                                            in (res, head (either snd snd res)))
+                                                        firstInp conts
+                    in case last results of
+                           Right (_, _) -> output
+                           Left (_, _) -> generation (map (fst . fromLeft undefined) results) output
+            in generation initConts 0
+    in maximum (map outcome settings)
+
+foldProduce :: (s -> a -> (b, s)) -> s -> [a] -> (s, [b])
+foldProduce _ s [] = (s, [])
+foldProduce f s (x:xs) = let (y, s') = f s x in fmap (y :) (foldProduce f s' xs)
+
+main :: IO ()
+main = do
+    program <- parse . head <$> getInput 7
+    print (part1 program)
+    print (part2 program)