day 23, 25
This commit is contained in:
parent
87dc22df59
commit
dca25b6003
|
@ -0,0 +1,106 @@
|
||||||
|
import Common
|
||||||
|
import Prelude hiding (Right, Left)
|
||||||
|
import Data.List.Split (splitOn)
|
||||||
|
import Data.Char (isNumber)
|
||||||
|
import Data.List (elemIndex)
|
||||||
|
import Data.Maybe (fromJust, fromMaybe)
|
||||||
|
|
||||||
|
data Tile = Blank | Empty | Wall
|
||||||
|
deriving (Eq, Show, Enum)
|
||||||
|
data Direction = L | R
|
||||||
|
deriving (Eq, Show, Enum)
|
||||||
|
data Facing = Up | Down | Left | Right
|
||||||
|
deriving (Eq, Show, Enum)
|
||||||
|
data Instruction = Face Direction | Step Int
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
type State = (Pos, Facing)
|
||||||
|
|
||||||
|
parseMap :: String -> Grid Tile
|
||||||
|
parseMap s = map parseRow rows
|
||||||
|
where
|
||||||
|
parseRow = map parseTile
|
||||||
|
|
||||||
|
parseTile '#' = Wall
|
||||||
|
parseTile '.' = Empty
|
||||||
|
parseTile ' ' = Blank
|
||||||
|
parseTile _ = undefined
|
||||||
|
|
||||||
|
rows = lines s
|
||||||
|
|
||||||
|
turn :: Facing -> Direction -> Facing
|
||||||
|
turn Left R = Up
|
||||||
|
turn Up R = Right
|
||||||
|
turn Right R = Down
|
||||||
|
turn Down R = Left
|
||||||
|
turn Left L = Down
|
||||||
|
turn Up L = Left
|
||||||
|
turn Right L = Up
|
||||||
|
turn Down L = Right
|
||||||
|
|
||||||
|
charToDir :: Char -> Direction
|
||||||
|
charToDir 'L' = L
|
||||||
|
charToDir 'R' = R
|
||||||
|
charToDir _ = undefined
|
||||||
|
|
||||||
|
parseInstructions :: String -> [Instruction]
|
||||||
|
parseInstructions s = parseNum s
|
||||||
|
where
|
||||||
|
parseDirection :: String -> [Instruction]
|
||||||
|
parseDirection [] = []
|
||||||
|
parseDirection s = Face (charToDir (head s)) : parseNum (tail s)
|
||||||
|
parseNum :: String -> [Instruction]
|
||||||
|
parseNum [] = []
|
||||||
|
parseNum s = Step (read num) : parseDirection rest
|
||||||
|
where (num, rest) = span isNumber s
|
||||||
|
|
||||||
|
getInitialState :: Grid Tile -> State
|
||||||
|
getInitialState map = ((fromJust $ elemIndex Empty (head map), 0), Right)
|
||||||
|
|
||||||
|
forward :: Facing -> Pos
|
||||||
|
forward Right = (1, 0)
|
||||||
|
forward Down = (0, 1)
|
||||||
|
forward Left = (-1, 0)
|
||||||
|
forward Up = (0, -1)
|
||||||
|
|
||||||
|
opposite :: Facing -> Facing
|
||||||
|
opposite Right = Left
|
||||||
|
opposite Left = Right
|
||||||
|
opposite Up = Down
|
||||||
|
opposite Down = Up
|
||||||
|
|
||||||
|
getTile :: Grid Tile -> Pos -> Tile
|
||||||
|
getTile grid pos = fromMaybe Blank (grid !!? pos)
|
||||||
|
|
||||||
|
stepThrough :: (Grid Tile, [Instruction]) -> State
|
||||||
|
stepThrough (grid, instructions) = step (getInitialState grid) instructions
|
||||||
|
where
|
||||||
|
step :: State -> [Instruction] -> State
|
||||||
|
step state [] = state
|
||||||
|
step ((x, y), facing) (instruction:xs) = case instruction of
|
||||||
|
Face dir -> step ((x, y), turn facing dir) xs
|
||||||
|
Step 0 -> step ((x, y), facing) xs
|
||||||
|
Step n -> case wrappedTile of
|
||||||
|
Wall -> step ((x, y), facing) xs
|
||||||
|
Empty -> step (wrappedPos, facing) (Step (n - 1) : xs)
|
||||||
|
Blank -> error "huh?"
|
||||||
|
where
|
||||||
|
wrappedTile = getTile grid wrappedPos
|
||||||
|
wrappedPos = if newTile == Blank then (until (\pos -> getTile grid pos == Blank && pos /= newPos) (`subPos` forward facing) newPos) `addPos` forward facing else newPos
|
||||||
|
newTile = getTile grid newPos
|
||||||
|
newPos = (x, y) `addPos` forward facing
|
||||||
|
|
||||||
|
facingToInt :: Facing -> Int
|
||||||
|
facingToInt Right = 0
|
||||||
|
facingToInt Down = 1
|
||||||
|
facingToInt Left = 2
|
||||||
|
facingToInt Up = 3
|
||||||
|
|
||||||
|
getPassword :: State -> Int
|
||||||
|
getPassword ((x, y), f) = 1000 * (y + 1) + 4 * (x + 1) + facingToInt f
|
||||||
|
|
||||||
|
main = interact $
|
||||||
|
show
|
||||||
|
. getPassword
|
||||||
|
. stepThrough
|
||||||
|
. (\[a, b] -> (parseMap $ unlines a, parseInstructions $ head b)) . splitOn [""] . lines
|
|
@ -0,0 +1,66 @@
|
||||||
|
import Common hiding (Grid)
|
||||||
|
import Data.List (foldl', elemIndices)
|
||||||
|
import Data.Maybe (mapMaybe, catMaybes)
|
||||||
|
|
||||||
|
data Direction = North | West | East | South
|
||||||
|
deriving (Eq, Show, Enum)
|
||||||
|
|
||||||
|
parse :: String -> [Pos]
|
||||||
|
parse s = concat $ zipWith (\y l -> map fst $ filter (\(pos, t) -> t == '#') $ zipWith (\x t -> ((x, y), t)) [0..] l) [0..] $ lines s
|
||||||
|
|
||||||
|
directionOrder = [North, South, West, East]
|
||||||
|
|
||||||
|
consideredPositions North = [(0, -1), (-1, -1), (1, -1)]
|
||||||
|
consideredPositions South = [(0, 1), (-1, 1), (1, 1)]
|
||||||
|
consideredPositions West = [(-1, 0), (-1, -1), (-1, 1)]
|
||||||
|
consideredPositions East = [(1, 0), (1, -1), (1, 1)]
|
||||||
|
|
||||||
|
directPosition North = (0, -1)
|
||||||
|
directPosition South = (0, 1)
|
||||||
|
directPosition West = (-1, 0)
|
||||||
|
directPosition East = (1, 0)
|
||||||
|
|
||||||
|
removeDuplicatesBy :: (Eq b) => (a -> b) -> [a] -> [a]
|
||||||
|
removeDuplicatesBy f l = filter (\e -> length (f e `elemIndices` l') == 1) l
|
||||||
|
where l' = map f l
|
||||||
|
|
||||||
|
removeDuplicates :: (Eq a) => [a] -> [a]
|
||||||
|
removeDuplicates = removeDuplicatesBy id
|
||||||
|
|
||||||
|
countEmpty :: [Pos] -> Int
|
||||||
|
countEmpty elves = sum $ map (\y -> sum $ map (\x -> if (x, y) `elem` elves then 0 else 1) [minX .. maxX]) [minY .. maxY]
|
||||||
|
where
|
||||||
|
minX = minimum $ map fst elves
|
||||||
|
maxX = maximum $ map fst elves
|
||||||
|
minY = minimum $ map snd elves
|
||||||
|
maxY = maximum $ map snd elves
|
||||||
|
|
||||||
|
unwrap :: (a, Maybe b) -> Maybe (a, b)
|
||||||
|
unwrap (a, Just b) = Just (a, b)
|
||||||
|
unwrap (a, Nothing) = Nothing
|
||||||
|
|
||||||
|
step :: [Pos] -> Int -> [Pos]
|
||||||
|
step elves round = movedElves
|
||||||
|
where
|
||||||
|
movedElves = map snd newElves ++ filter (`notElem` map fst newElves) elves
|
||||||
|
|
||||||
|
newElves = removeDuplicatesBy snd $ mapMaybe unwrap $ zip elves $ map getElfPosition elves
|
||||||
|
|
||||||
|
getElfPosition :: Pos -> Maybe Pos
|
||||||
|
getElfPosition pos
|
||||||
|
| (not $ or positions) || (and positions) = Nothing
|
||||||
|
| otherwise = Just firstPos
|
||||||
|
where
|
||||||
|
firstPos = (pos `addPos`) $ directPosition firstDir
|
||||||
|
firstDir = fst $ head $ filter snd $ zip order positions
|
||||||
|
positions = map (all ((`notElem` elves) . (pos `addPos`)) . consideredPositions) order
|
||||||
|
|
||||||
|
order = map ((cycle directionOrder !!) . flip (-) 1 . (+ round)) [0..3]
|
||||||
|
|
||||||
|
roundsN = 10
|
||||||
|
|
||||||
|
main = interact $
|
||||||
|
show
|
||||||
|
. countEmpty
|
||||||
|
. (\elves -> foldl' step elves [1 .. roundsN])
|
||||||
|
. parse
|
|
@ -0,0 +1,62 @@
|
||||||
|
import Common hiding (Grid)
|
||||||
|
import Data.List (foldl', elemIndices)
|
||||||
|
import Data.Maybe (mapMaybe, catMaybes)
|
||||||
|
|
||||||
|
data Direction = North | West | East | South
|
||||||
|
deriving (Eq, Show, Enum)
|
||||||
|
|
||||||
|
parse :: String -> [Pos]
|
||||||
|
parse s = concat $ zipWith (\y l -> map fst $ filter (\(pos, t) -> t == '#') $ zipWith (\x t -> ((x, y), t)) [0..] l) [0..] $ lines s
|
||||||
|
|
||||||
|
directionOrder = [North, South, West, East]
|
||||||
|
|
||||||
|
consideredPositions North = [(0, -1), (-1, -1), (1, -1)]
|
||||||
|
consideredPositions South = [(0, 1), (-1, 1), (1, 1)]
|
||||||
|
consideredPositions West = [(-1, 0), (-1, -1), (-1, 1)]
|
||||||
|
consideredPositions East = [(1, 0), (1, -1), (1, 1)]
|
||||||
|
|
||||||
|
directPosition North = (0, -1)
|
||||||
|
directPosition South = (0, 1)
|
||||||
|
directPosition West = (-1, 0)
|
||||||
|
directPosition East = (1, 0)
|
||||||
|
|
||||||
|
removeDuplicatesBy :: (Eq b) => (a -> b) -> [a] -> [a]
|
||||||
|
removeDuplicatesBy f l = filter (\e -> length (f e `elemIndices` l') == 1) l
|
||||||
|
where l' = map f l
|
||||||
|
|
||||||
|
removeDuplicates :: (Eq a) => [a] -> [a]
|
||||||
|
removeDuplicates = removeDuplicatesBy id
|
||||||
|
|
||||||
|
unwrap :: (a, Maybe b) -> Maybe (a, b)
|
||||||
|
unwrap (a, Just b) = Just (a, b)
|
||||||
|
unwrap (a, Nothing) = Nothing
|
||||||
|
|
||||||
|
step :: [Pos] -> Int -> Maybe [Pos]
|
||||||
|
step elves round = if null newElves then Nothing else Just movedElves
|
||||||
|
where
|
||||||
|
movedElves = map snd newElves ++ filter (`notElem` map fst newElves) elves
|
||||||
|
|
||||||
|
newElves = removeDuplicatesBy snd $ mapMaybe unwrap $ zip elves $ map getElfPosition elves
|
||||||
|
|
||||||
|
getElfPosition :: Pos -> Maybe Pos
|
||||||
|
getElfPosition pos
|
||||||
|
| (not $ or positions) || (and positions) = Nothing
|
||||||
|
| otherwise = Just firstPos
|
||||||
|
where
|
||||||
|
firstPos = (pos `addPos`) $ directPosition firstDir
|
||||||
|
firstDir = fst $ head $ filter snd $ zip order positions
|
||||||
|
positions = map (all ((`notElem` elves) . (pos `addPos`)) . consideredPositions) order
|
||||||
|
|
||||||
|
order = map ((cycle directionOrder !!) . flip (-) 1 . (+ round)) [0..3]
|
||||||
|
|
||||||
|
repeatStepUntilStill :: [Pos] -> Int -> Int
|
||||||
|
repeatStepUntilStill elves round = case newElves of
|
||||||
|
Just e -> repeatStepUntilStill e (round + 1)
|
||||||
|
Nothing -> round
|
||||||
|
where
|
||||||
|
newElves = step elves round
|
||||||
|
|
||||||
|
main = interact $
|
||||||
|
show
|
||||||
|
. (\elves -> repeatStepUntilStill elves 1)
|
||||||
|
. parse
|
|
@ -0,0 +1,26 @@
|
||||||
|
readSNAFUDigit '2' = 2
|
||||||
|
readSNAFUDigit '1' = 1
|
||||||
|
readSNAFUDigit '0' = 0
|
||||||
|
readSNAFUDigit '-' = -1
|
||||||
|
readSNAFUDigit '=' = -2
|
||||||
|
readSNAFUDigit _ = undefined
|
||||||
|
|
||||||
|
readSNAFU :: String -> Int
|
||||||
|
readSNAFU s = sum $ zipWith (\c m -> readSNAFUDigit c * m) s (map (5 ^) (reverse [0 .. length s - 1]))
|
||||||
|
|
||||||
|
showSNAFUDigit 0 = '0'
|
||||||
|
showSNAFUDigit 1 = '1'
|
||||||
|
showSNAFUDigit 2 = '2'
|
||||||
|
showSNAFUDigit 3 = '='
|
||||||
|
showSNAFUDigit 4 = '-'
|
||||||
|
showSNAFUDigit _ = undefined
|
||||||
|
|
||||||
|
showSNAFU :: Int -> String
|
||||||
|
showSNAFU n
|
||||||
|
| n > 0 = showSNAFU ((n + 2) `div` 5) ++ [showSNAFUDigit (n `mod` 5)]
|
||||||
|
| otherwise = ""
|
||||||
|
|
||||||
|
main = interact $ showSNAFU
|
||||||
|
. sum
|
||||||
|
. map readSNAFU
|
||||||
|
. lines
|
10
Common.hs
10
Common.hs
|
@ -27,9 +27,19 @@ add3 (x1, y1, z1) (x2, y2, z2) = (x1 + x2, y1 + y2, z1 + z2)
|
||||||
|
|
||||||
type Grid a = [[a]]
|
type Grid a = [[a]]
|
||||||
|
|
||||||
|
(!?) :: [a] -> Int -> Maybe a
|
||||||
|
xs !? n
|
||||||
|
| n < 0 = Nothing
|
||||||
|
| otherwise = foldr (\x r k -> case k of
|
||||||
|
0 -> Just x
|
||||||
|
_ -> r (k-1)) (const Nothing) xs n
|
||||||
|
|
||||||
(!!!) :: Grid a -> Pos -> a
|
(!!!) :: Grid a -> Pos -> a
|
||||||
(!!!) grid (x, y) = grid !! y !! x
|
(!!!) grid (x, y) = grid !! y !! x
|
||||||
|
|
||||||
|
(!!?) :: Grid a -> Pos -> Maybe a
|
||||||
|
(!!?) grid (x, y) = (grid !? y) >>= (!? x)
|
||||||
|
|
||||||
findPos :: (Eq a) => a -> Grid a -> Maybe Pos
|
findPos :: (Eq a) => a -> Grid a -> Maybe Pos
|
||||||
findPos target grid = do
|
findPos target grid = do
|
||||||
y <- findIndex (target `elem`) grid
|
y <- findIndex (target `elem`) grid
|
||||||
|
|
Loading…
Reference in New Issue