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]]
|
||||
|
||||
(!?) :: [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 (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 target grid = do
|
||||
y <- findIndex (target `elem`) grid
|
||||
|
|
|
|||
Loading…
Reference in New Issue