Day9.hs

-- day 9
day9 :: IO ()
day9 = do
  dt <- getDayInput "9"
  let exDirs = parseCleanDay9 dt
  putStrLn $ "day 1 part 1 " <> (show $ evalDay9 exDirs (scanl' tailFollow (0,0)))
  putStrLn $ "day 1 part 2 " <> (show $ evalDay9 exDirs (oneRope . oneRope . oneRope . oneRope . oneRope . oneRope . oneRope . oneRope . oneRope))
      where oneRope = scanl1 tailFollow

parseCleanDay9 :: Text -> [Direction]
parseCleanDay9 txt =
    let directions = parseMaybe (pDirection `sepEndBy` char '\n') txt
    in concat $ maybe [] (fmap expandDirections) directions

evalDay9 :: Eq a => [Direction] -> ([(Int, Int)] -> [a]) -> Int
evalDay9 expandedDirs tailF =
        let headLocations = scanl' stepHead (0,0) expandedDirs
            tailLocations = tailF headLocations
        in length $ nub $ tailLocations

data Direction = R Int | L Int | U Int | D Int deriving (Eq, Ord, Show)

pDirection :: Parser Direction
pDirection = R <$ string "R " <*> L.decimal
             <|> L <$ string "L " <*> L.decimal
             <|> U <$ string "U " <*> L.decimal
             <|> D <$ string "D " <*> L.decimal

expandDirections :: Direction -> [Direction]
expandDirections (D n) = replicate n (D 1)
expandDirections (L n) = replicate n (L 1)
expandDirections (R n) = replicate n (R 1)
expandDirections (U n) = replicate n (U 1)

stepHead :: (Int,Int) -> Direction -> (Int,Int)
stepHead (x,y) (D 1) = (x,y-1)
stepHead (x,y) (U 1) = (x,y+1)
stepHead (x,y) (L 1) = (x-1,y)
stepHead (x,y) (R 1) = (x+1,y)
stepHead _ _ = error "stepHead got bad input"

{- follow function
If the head is ever two steps directly up, down, left, or right from the tail, the tail must also move one step in that direction so it remains close enough

Otherwise, if the head and tail aren't touching and aren't in the same row or column, the tail always moves one step diagonally to keep up
-}

tailFollow :: (Int,Int) -> (Int,Int) -> (Int,Int)
tailFollow  t@(xt,yt) h@(xh,yh) =
    if | isTouching h t -> t
       | yh == yt -> if xh > xt then (xt + 1,yt) else (xt - 1, yt) -- same row
       | xh == xt -> if yh > yt then (xt, yt + 1) else (xt, yt - 1) -- same column
       | otherwise -> diagonalTail h t

diagonalTail :: (Int,Int) -> (Int,Int) -> (Int,Int)
diagonalTail (xh,yh) (xt,yt) =
    if | xh > xt -> if | yh > yt -> (xt+1,yt+1)
                       | otherwise -> (xt+1,yt-1)
       | otherwise -> if | yh > yt -> (xt-1,yt+1)
                         | otherwise -> (xt-1,yt-1)

isTouching :: (Int, Int) -> (Int,Int) -> Bool
isTouching (x1,y1) (x2,y2) = abs (x1 - x2) <= 1 && abs (y1 - y2) <= 1