138 lines
3.4 KiB
Haskell
138 lines
3.4 KiB
Haskell
module Day9.Main where
|
|
|
|
import System.IO
|
|
import Data.List
|
|
import Data.List.Split
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Day 9"
|
|
|
|
handle <- openFile "app/Day9/example" ReadMode
|
|
contents <- hGetContents handle
|
|
|
|
let r1 = part1 contents
|
|
putStrLn $ "part 1: " ++ show r1
|
|
|
|
let r2 = part2 contents
|
|
putStrLn $ "part 2: " ++ show r2
|
|
|
|
data Direction = DUp | DDown | DLeft | DRight
|
|
deriving (Show)
|
|
|
|
data Heading = None | N | E | S | W | NE | SE | SW | NW
|
|
|
|
type Motion = (Int, Direction)
|
|
type Point = (Int, Int)
|
|
type Rope = (Point, Point) -- head, tail
|
|
|
|
instance Read Direction where
|
|
readsPrec _ "R" = [(DRight, "")]
|
|
readsPrec _ "L" = [(DLeft, "")]
|
|
readsPrec _ "U" = [(DUp, "")]
|
|
readsPrec _ "D" = [(DDown, "")]
|
|
|
|
toMotion :: [String] -> Motion
|
|
toMotion (a:b:_) = (read b, read a)
|
|
|
|
toHeading :: Rope -> Heading
|
|
toHeading ((hx,hy),(tx,ty))
|
|
| hx == tx &&
|
|
hy == ty = None
|
|
|
|
| hx == tx &&
|
|
hy < ty = S
|
|
| hx == tx &&
|
|
hy > ty = N
|
|
| hy == ty &&
|
|
hx < tx = W
|
|
| hy == ty &&
|
|
hx > tx = E
|
|
|
|
| hx < tx &&
|
|
hy < ty = SW
|
|
| hx < tx &&
|
|
hy > ty = NW
|
|
| hx > tx &&
|
|
hy < ty = SE
|
|
| hx > tx &&
|
|
hy > ty = NE
|
|
|
|
parseData :: String -> [Motion]
|
|
parseData = (map toMotion) . (map (splitOn " ")) . lines
|
|
|
|
expandMovement :: [Motion] -> [Direction]
|
|
expandMovement = concatMap (uncurry replicate)
|
|
|
|
doMovement :: Rope -> Direction -> Rope
|
|
doMovement rope DUp =
|
|
case toHeading rope of
|
|
None -> ((hx, hy+1), (tx, ty))
|
|
|
|
N -> ((hx, hy+1), (tx, ty+1))
|
|
E -> ((hx, hy+1), (tx, ty))
|
|
S -> ((hx, hy+1), (tx, ty))
|
|
W -> ((hx, hy+1), (tx, ty))
|
|
|
|
NE -> ((hx, hy+1), (tx+1, ty+1))
|
|
SE -> ((hx, hy+1), (tx, ty))
|
|
SW -> ((hx, hy+1), (tx, ty))
|
|
NW -> ((hx, hy+1), (tx-1, ty+1))
|
|
where
|
|
((hx, hy), (tx, ty)) = rope
|
|
|
|
doMovement rope DDown =
|
|
case toHeading rope of
|
|
None -> ((hx, hy-1), (tx, ty))
|
|
|
|
N -> ((hx, hy-1), (tx, ty))
|
|
E -> ((hx, hy-1), (tx, ty))
|
|
S -> ((hx, hy-1), (tx, ty-1))
|
|
W -> ((hx, hy-1), (tx, ty))
|
|
|
|
NE -> ((hx, hy-1), (tx, ty))
|
|
SE -> ((hx, hy-1), (tx+1, ty-1))
|
|
SW -> ((hx, hy-1), (tx-1, ty-1))
|
|
NW -> ((hx, hy-1), (tx, ty))
|
|
where
|
|
((hx, hy), (tx, ty)) = rope
|
|
|
|
doMovement rope DLeft =
|
|
case toHeading rope of
|
|
None -> ((hx-1, hy), (tx, ty))
|
|
|
|
N -> ((hx-1, hy), (tx, ty))
|
|
E -> ((hx-1, hy), (tx, ty))
|
|
S -> ((hx-1, hy), (tx, ty))
|
|
W -> ((hx-1, hy), (tx-1, ty))
|
|
|
|
NE -> ((hx-1, hy), (tx, ty))
|
|
SE -> ((hx-1, hy), (tx, ty))
|
|
SW -> ((hx-1, hy), (tx-1, ty-1))
|
|
NW -> ((hx-1, hy), (tx-1, ty+1))
|
|
where
|
|
((hx, hy), (tx, ty)) = rope
|
|
|
|
doMovement rope DRight =
|
|
case toHeading rope of
|
|
None -> ((hx+1, hy), (tx, ty))
|
|
|
|
N -> ((hx+1, hy), (tx, ty))
|
|
E -> ((hx+1, hy), (tx+1, ty))
|
|
S -> ((hx+1, hy), (tx, ty))
|
|
W -> ((hx+1, hy), (tx, ty))
|
|
|
|
NE -> ((hx+1, hy), (tx+1, ty+1))
|
|
SE -> ((hx+1, hy), (tx+1, ty-1))
|
|
SW -> ((hx+1, hy), (tx, ty))
|
|
NW -> ((hx+1, hy), (tx, ty))
|
|
where
|
|
((hx, hy), (tx, ty)) = rope
|
|
|
|
part1 contents = path
|
|
where
|
|
steps = expandMovement $ parseData contents
|
|
step = take 2 steps
|
|
(final, path) = foldr (\m (r, ps) -> let (h,t) = doMovement r m in ((h,t), (t:ps))) (((0,0),(0,0)),[(0,0)]) steps
|
|
part2 contents = 1
|