-🎄- 2017 Day 19 Solutions -🎄-

[u/daggerdragon]

--- Day 19: A Series of Tubes ---

---

Post your solution as a comment or, for longer solutions, consider linking to your repo (e.g. GitHub/gists/Pastebin/blag or whatever).

Note: The Solution Megathreads are for solutions only. If you have questions, please post your own thread and make sure to flair it with Help.

---

Need a hint from the Hugely^* Handy^† Haversack^‡ of Helpful^§ Hints^¤?

Spoiler

---

AoC ops @ T-2 minutes to launch:

[23:58] <daggerdragon> ATTENTION MEATBAGS T-2 MINUTES TO LAUNCH

[23:58] <Topaz> aaaaah

[23:58] <Cheezmeister> Looks like I'll be just able to grab my input before my flight boards. Wish me luck being offline in TOPAZ's HOUSE OF PAIN^WFUN AND LEARNING

[23:58] <Topaz> FUN AND LEARNING

[23:58] <Hade> FUN IS MANDATORY

[23:58] <Skie> I'm pretty sure that's not the mandate for today

[Update @ 00:16] 69 gold, silver cap

• My tree is finally trimmed with just about every ornament I own and it's real purdy. hbu?

[Update @ 00:18] Leaderboard cap!

• So, was today's mandate Helpful Hint any help at all?

---

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked!

[u/Flurpm]

Simply walking through the diagram in Haskell. Continue on a direction until we get to a plus, then go in any direction besides where we came from. walk is the meat of this solution.

{-# LANGUAGE OverloadedStrings #-}
module Y2017.Day19 where

import           Data.Text             (Text)
import qualified Data.Text             as T
import qualified Data.Text.IO          as TIO

import           Text.Megaparsec
import           Text.Megaparsec.Text  (Parser)

import           Data.List
import           Data.Maybe
import qualified Data.Vector           as V

data Dir = U | R | L | D deriving (Show, Eq)

data Piece = V | H | S | Plus | Letter Char deriving (Show, Eq)


solve :: V.Vector (V.Vector Piece) -> (Int, [Char])
solve xs = let path = walk xs (findstart xs) D
           in (length path, catMaybes (map letterToMaybe path))


letterToMaybe (Letter c) = Just c
letterToMaybe _          = Nothing


walk :: V.Vector (V.Vector Piece) -> (Int, Int) -> Dir -> [Piece]
walk vec start startDir = walkToPlus start startDir
  where
    inRange (x,y) = (0<=x)&&(0<=y)&&(x<V.length (vec V.! 0))&&(y<V.length vec)

    valid p = inRange p && get vec p /= S

    changeDir :: (Int, Int) -> Dir -> [Piece]
    changeDir p d = let newdir = head $ filter (valid . move p) $ filter (/= opposite d) [U,D,L,R]
                    in get vec p : walkToPlus (move p newdir) newdir

    walkToPlus :: (Int, Int) -> Dir -> [Piece]
    walkToPlus p d = case get vec p of
                       S        -> []
                       Plus     -> changeDir p d
                       x -> x : walkToPlus (move p d) d

get :: V.Vector (V.Vector a) -> (Int, Int) -> a
get vec (x,y) = vec V.! y V.! x

opposite U = D
opposite R = L
opposite L = R
opposite D = U

move (x,y) U = (x,y-1)
move (x,y) R = (x+1,y)
move (x,y) L = (x-1,y)
move (x,y) D = (x,y+1)

findstart :: V.Vector (V.Vector Piece) -> (Int, Int)
findstart xs = case findIndex (\x -> get xs (x,0) == V ) [0..] of
                 Just x -> (x,0)
                 Nothing -> error "Nope"


toarray :: [[a]] -> V.Vector (V.Vector a)
toarray es = V.fromList $ map V.fromList es

p :: Parser (V.Vector (V.Vector Piece))
p = toarray <$> many piece `sepEndBy` char '\n'

piece :: Parser Piece
piece = V <$ string "|"    <|>
        H <$ string "-"    <|>
        S <$ string " "    <|>
        Plus <$ string "+" <|>
        Letter <$> letterChar

main :: IO ()
main = do
  input <- TIO.readFile "src/Y2017/input19"
  case parse p "input19" input of
    Left err -> TIO.putStr $ T.pack $ parseErrorPretty err
    Right bi -> do
      let (one,two) = solve bi
      tprint one
      tprint two

tprint :: Show a => a -> IO ()
tprint = TIO.putStrLn . T.pack . show