All done!

8 files changed, 96 insertions, 0 deletions

diff --git a/Puzzle24 b/Puzzle24
new file mode 100755
index 0000000..fcb874d
--- /dev/null
+++ b/Puzzle24
diff --git a/Puzzle24.hi b/Puzzle24.hi
new file mode 100644
index 0000000..dce909c
--- /dev/null
+++ b/Puzzle24.hi
diff --git a/Puzzle24.hs b/Puzzle24.hs
new file mode 100644
index 0000000..639f4a3
--- /dev/null
+++ b/Puzzle24.hs
@@ -0,0 +1,26 @@
+-- Acknowledgements:
+-- https://www.reddit.com/r/adventofcode/comments/7lte5z/2017_day_24_solutions/drs1eml/
+-- https://stackoverflow.com/a/4708372/4063224
+import Data.List (delete, concatMap)
+import Data.List.Split (splitOn)
+
+extBridge :: [Int] -> [[Int]] -> [[Int]]
+extBridge xs ys
+  | null zs = [xs]
+  | otherwise = concatMap f zs
+    where x = head xs
+          zs = filter (elem x) ys
+          f [y, z] = extBridge (if y == x then (z:y:xs) else (y:z:xs)) (delete [y, z] ys)
+
+parseInput :: [Char] -> [[Int]]
+parseInput xs = (fmap read . splitOn "/") <$> splitOn "\n" xs
+
+solve1 :: [Char] -> Int
+solve1 = maximum . fmap sum . (extBridge [0]) . parseInput
+
+solve2 :: [Char] -> Int
+solve2 = snd . maximum . fmap (\xs -> (length xs, sum xs)) . (extBridge [0]) . parseInput
+
+input0 = "0/2\n2/2\n2/3\n3/4\n3/5\n0/1\n10/1\n9/10"
+
+input = "50/41\n19/43\n17/50\n32/32\n22/44\n9/39\n49/49\n50/39\n49/10\n37/28\n33/44\n14/14\n14/40\n8/40\n10/25\n38/26\n23/6\n4/16\n49/25\n6/39\n0/50\n19/36\n37/37\n42/26\n17/0\n24/4\n0/36\n6/9\n41/3\n13/3\n49/21\n19/34\n16/46\n22/33\n11/6\n22/26\n16/40\n27/21\n31/46\n13/2\n24/7\n37/45\n49/2\n32/11\n3/10\n32/49\n36/21\n47/47\n43/43\n27/19\n14/22\n13/43\n29/0\n33/36\n2/6"
diff --git a/Puzzle24.o b/Puzzle24.o
new file mode 100644
index 0000000..55cebbe
--- /dev/null
+++ b/Puzzle24.o
diff --git a/Puzzle25 b/Puzzle25
new file mode 100755
index 0000000..4f875b5
--- /dev/null
+++ b/Puzzle25
diff --git a/Puzzle25.hi b/Puzzle25.hi
new file mode 100644
index 0000000..5dd114a
--- /dev/null
+++ b/Puzzle25.hi
diff --git a/Puzzle25.hs b/Puzzle25.hs
new file mode 100644
index 0000000..656e91d
--- /dev/null
+++ b/Puzzle25.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+import Text.Parsec.Prim
+import Text.Parsec.Char
+import Text.Parsec.Combinator
+import Data.Functor.Identity (Identity)
+import Data.Either (fromRight)
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+type Rule = Map (Char, Int) (Int, Char, Int)
+
+run :: Int -> Int -> Char -> [Int] -> Rule -> [Int]
+run 0 _ _ tape _ = tape
+run !n !cursor !st !tape !rule = 
+  run (n - 1) cursor'' st' tape'' rule
+    where val = tape !! cursor
+          (shift, st', val') = rule Map.! (st, val)
+          tape' = (take cursor tape) ++ (val':(drop (cursor + 1) tape))
+          cursor' = cursor + shift
+          tape'' = if (cursor' == -1) then 0:tape' else if (cursor' >= length tape) then tape' ++ [0] else tape'
+          cursor'' = max cursor' 0
+
+turingParse :: Stream s Identity Char => Parsec s () (Int, Char, Rule)
+turingParse = do
+  (initN, initSt) <- preamble
+  rule <- Map.fromList <$> (mconcat <$> many1 paragraph)
+  return (initN, initSt, rule)
+
+preamble :: Stream s Identity Char => Parsec s () (Int, Char)
+preamble = do
+  string "Begin in state "
+  initSt <- anyChar
+  string ".\nPerform a diagnostic checksum after "
+  initN <- read <$> many1 digit
+  string " steps.\n\n"
+  return (initN, initSt)
+  
+paragraph :: Stream s Identity Char => Parsec s () [((Char, Int), (Int, Char, Int))]
+paragraph = do
+  string "In state "
+  st <- anyChar
+  string ":\n" >> many space
+  (val0, val0', shift0, st0') <- branch
+  many space
+  (val1, val1', shift1, st1') <- branch
+  newline
+  return [((st, val0), (shift0, st0', val0')), ((st, val1), (shift1, st1', val1'))]
+
+branch :: Stream s Identity Char => Parsec s () (Int, Int, Int, Char)
+branch = do
+  string "If the current value is "
+  val <- read <$> many1 digit
+  string ":\n" >> many space >> string "- Write the value "
+  val' <- read <$> many1 digit
+  string ".\n" >> many space >> string "- Move one slot to the "
+  shift <- (\x -> if x == "left" then -1 else 1) <$> ((string "left") <|> (string "right"))
+  string ".\n" >> many space >> string "- Continue with state "
+  st' <- anyChar
+  string ".\n"
+  return (val, val', shift, st')
+
+solve1 xs = let (initN, initSt, rule) = fromRight (0, 'A', Map.empty) $ parse turingParse "" xs in
+  sum $ run initN 0 initSt [0] rule
+
+main = putStr $ show $ solve1 input
+
+input0 = "Begin in state A.\nPerform a diagnostic checksum after 6 steps.\n\nIn state A:\n  If the current value is 0:\n    - Write the value 1.\n    - Move one slot to the right.\n    - Continue with state B.\n  If the current value is 1:\n    - Write the value 0.\n    - Move one slot to the left.\n    - Continue with state B.\n\nIn state B:\n  If the current value is 0:\n    - Write the value 1.\n    - Move one slot to the left.\n    - Continue with state A.\n  If the current value is 1:\n    - Write the value 1.\n    - Move one slot to the right.\n    - Continue with state A.\n\n"
+
+input = "Begin in state A.\nPerform a diagnostic checksum after 12399302 steps.\n\nIn state A:\n  If the current value is 0:\n    - Write the value 1.\n    - Move one slot to the right.\n    - Continue with state B.\n  If the current value is 1:\n    - Write the value 0.\n    - Move one slot to the right.\n    - Continue with state C.\n\nIn state B:\n  If the current value is 0:\n    - Write the value 0.\n    - Move one slot to the left.\n    - Continue with state A.\n  If the current value is 1:\n    - Write the value 0.\n    - Move one slot to the right.\n    - Continue with state D.\n\nIn state C:\n  If the current value is 0:\n    - Write the value 1.\n    - Move one slot to the right.\n    - Continue with state D.\n  If the current value is 1:\n    - Write the value 1.\n    - Move one slot to the right.\n    - Continue with state A.\n\nIn state D:\n  If the current value is 0:\n    - Write the value 1.\n    - Move one slot to the left.\n    - Continue with state E.\n  If the current value is 1:\n    - Write the value 0.\n    - Move one slot to the left.\n    - Continue with state D.\n\nIn state E:\n  If the current value is 0:\n    - Write the value 1.\n    - Move one slot to the right.\n    - Continue with state F.\n  If the current value is 1:\n    - Write the value 1.\n    - Move one slot to the left.\n    - Continue with state B.\n\nIn state F:\n  If the current value is 0:\n    - Write the value 1.\n    - Move one slot to the right.\n    - Continue with state A.\n  If the current value is 1:\n    - Write the value 1.\n    - Move one slot to the right.\n    - Continue with state E.\n\n"
diff --git a/Puzzle25.o b/Puzzle25.o
new file mode 100644
index 0000000..0d86bd3
--- /dev/null
+++ b/Puzzle25.o