Day nine advent

DayNine.hs

module DayNine
    ( partOne
    ) where
import qualified Data.Text as T
import qualified Data.Text.IO as TI
import qualified Data.Maybe as M
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.List.Extra as LE

data Movement = MoveRight | MoveUp | MoveLeft | MoveDown deriving (Show, Eq)

data Location = Location Integer Integer deriving (Show, Eq, Ord)
xCoord (Location x _) = x
yCoord (Location _ c) = c

origin = Location 0 0


data GameState = GameState [Location] deriving (Show, Eq)
locations (GameState ls) = ls

initialState n = GameState $ replicate n origin

testLines = map T.pack ["R 4","U 4","L 3","D 1","R 4","D 1","L 5","R 2"]

cartesianProduct a b = (,) <$> a <*> b

applyMovement MoveUp (Location x y) = Location x (y + 1)
applyMovement MoveDown (Location x y) = Location x (y - 1)
applyMovement MoveLeft (Location x y) = Location (x - 1) y
applyMovement MoveRight (Location x y) = Location (x + 1) y

neighbors (Location x y) = map make prod
  where make (x,y) = Location x y
        prod = cartesianProduct [x-1,x,x+1] [y-1,y,y+1]

areNeighbors (Location x1 y1) (Location x2 y2) = (abs (x1 - x2)) < 2 && (abs (y1 - y2)) < 2
manhattan (Location x1 y1) (Location x2 y2) = (abs (x1 - x2)) + (abs (y1 - y2))

chase head@(Location x1 y1) tail@(Location x2 y2) = if areNeighbors head tail
                                                      then tail
                                                      else LE.minimumOn (manhattan head) (neighbors tail)

reconcile :: [Location] -> [Location]
reconcile [] = []
reconcile [e] = [e]
reconcile (firstItem:(secondItem:rest)) = firstItem : (reconcile ((chase firstItem secondItem):rest))

executeInstruction instruction (GameState items@(h:t)) = GameState $ reconcile $ (move h):t
  where move = applyMovement instruction



playWholeGame :: [GameState] -> [Movement] -> [GameState]
playWholeGame history [] = history
playWholeGame history@(latestPosition:_) (instruction:remainingInstructions) =
  playWholeGame (newState:history) remainingInstructions
  where newState = executeInstruction instruction latestPosition


parse lines = L.concatMap go $ map T.unpack lines
  where go ('R':rest) = replicate (parseCount rest) MoveRight
        go ('U':rest) = replicate (parseCount rest) MoveUp
        go ('L':rest) = replicate (parseCount rest) MoveLeft
        go ('D':rest) = replicate (parseCount rest) MoveDown
        parseCount stuff = read $ T.unpack $ last $ T.split (== ' ') $ T.pack stuff

test = main 2 $ parse testLines

main chainSize parsed = length $ S.fromList $ map (last . locations) played
  where played = playWholeGame [initialState chainSize] parsed

partOne :: String -> IO Int
partOne path =
  do
    input <- TI.readFile path
    let inputLines = T.lines input
        parsed = parse inputLines
    return $ main 2 parsed

partTwo :: String -> IO Int
partTwo path =
  do
    input <- TI.readFile path
    let inputLines = T.lines input
        parsed = parse inputLines
    return $ main 10 parsed