Day 19

1 files changed, 73 insertions, 0 deletions

diff --git a/2017/19.hs b/2017/19.hs
new file mode 100644
index 0000000..d6b2d47
--- /dev/null
+++ b/2017/19.hs
@@ -0,0 +1,73 @@
+import Prelude hiding (Right, Left, flip)
+import Control.Monad
+import Data.Array.Unboxed
+import Data.Char
+
+
+type Idx = (Int, Int)
+type Chart = UArray Idx Char
+data Dir = Up | Right | Down | Left
+  deriving (Show, Eq)
+
+add :: Idx -> Dir -> Idx
+add (y, x) dir = case dir of
+    Up -> (y - 1, x)
+    Right -> (y, x + 1)
+    Down -> (y + 1, x)
+    Left -> (y, x - 1)
+
+flip :: Dir -> Dir
+flip Down = Up
+flip Up = Down
+flip Right = Left
+flip Left = Right
+
+corresponds :: Char -> Dir -> Bool
+corresponds '|' dir = dir `elem` [Down, Up]
+corresponds '-' dir = dir `elem` [Right, Left]
+corresponds '+' _ = True
+corresponds c _ | isAlpha c = True
+corresponds ' ' _ = False
+corresponds c d = error ("corresponds: " ++ show c ++ " " ++ show d)
+
+steer :: Chart -> Idx -> Char -> Dir -> Dir
+steer _ _ '|' Down = Down
+steer _ _ '|' Up = Up
+steer _ _ '|' dir = dir
+steer _ _ '-' Right = Right
+steer _ _ '-' Left = Left
+steer _ _ '-' dir = dir
+steer chart idx '+' dir =
+    let [newdir] = [dir' | dir' <- [Up, Right, Down, Left],
+                           dir' /= flip dir,
+                           corresponds (chart ! add idx dir') dir']
+    in newdir
+steer _ idx ' ' dir = error ("Went into spaces with direction " ++ show dir ++ " at " ++ show idx)
+
+follow :: Chart -> Idx -> Dir -> ([Char], Int)
+follow chart idx dir =
+    if isAlpha (chart ! idx)
+        then if chart ! add idx dir == ' '
+                then ([chart ! idx], 1)
+                else let (str, count) = follow chart (add idx dir) dir
+                     in (chart ! idx : str, count + 1)
+        else let newdir = steer chart idx (chart ! idx) dir
+             in fmap succ $ follow chart (add idx newdir) newdir
+
+findStart :: Chart -> Idx
+findStart chart =
+    let ((0, 0), (_, w')) = bounds chart
+        [x] = [i | i <- [0..w'], chart ! (0, i) /= ' ']
+    in (0, x)
+
+main :: IO ()
+main = do
+    input <- (readFile "19.in")
+    let w = length (head (lines input))
+        h = length (lines input)
+        chart = listArray ((0, 0), (h-1, w-1)) (filter (/= '\n') input)
+
+    let start = findStart chart
+        (str, count) = follow chart start Down
+    putStrLn str
+    print count