Compare commits

...

4 commits

2 changed files with 15 additions and 15 deletions

View file

@ -5,6 +5,7 @@ module Day14 where
import AoC import AoC
import Data.Bits import Data.Bits
import Data.List
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
@ -26,7 +27,7 @@ parseMaskDecl :: ReadP Mask
parseMaskDecl = do parseMaskDecl = do
string "mask = " string "mask = "
mask <- many1 (choice $ char <$> "01X") mask <- many1 (choice $ char <$> "01X")
let extractMask c = foldl setBit zeroBits . map fst . filter ((==c) . snd) . enumerate 0 . reverse $ mask let extractMask c = foldl setBit zeroBits . findIndices (==c) . reverse $ mask
return $ Mask { set = extractMask '1' return $ Mask { set = extractMask '1'
, clear = extractMask '0' , clear = extractMask '0'
, dontcare = extractMask 'X' , dontcare = extractMask 'X'

View file

@ -53,33 +53,32 @@ parseInput = do
return $ Input {fields, myTicket, otherTickets } return $ Input {fields, myTicket, otherTickets }
matchesAnyField :: [Field] -> Int -> Bool matchesAnyField :: [Field] -> Int -> Bool
matchesAnyField fields n = any (n `S.member`) . map valids $ fields matchesAnyField fields n = any ((n `S.member`) . valids) fields
iterateUntilDone :: (a -> Maybe a) -> a -> a iterateUntilNothing :: (a -> Maybe a) -> a -> a
iterateUntilDone f x = case f x of iterateUntilNothing f x = maybe x (iterateUntilNothing f) $ f x
Just x' -> iterateUntilDone f x'
Nothing -> x
data Resolve a = Resolved a | Choice (Set a) deriving (Show) data Resolve a = Resolved a | Choice (Set a) deriving (Show)
resolve :: Ord a => [[a]] -> Maybe [a] resolve :: Ord a => [[a]] -> Maybe [a]
resolve = sequence . map fromResolved . iterateUntilDone resolve' . map (Choice . S.fromList) resolve = sequence . map fromResolved . iterateUntilNothing resolve' . map (Choice . S.fromList)
where fromResolved (Resolved x) = Just x where fromResolved (Resolved x) = Just x
fromResolved _ = Nothing fromResolved _ = Nothing
findSingletonChoice :: [Resolve a] -> Maybe (a, [Resolve a]) findSingletonChoice :: [Resolve a] -> Maybe (a, [Resolve a])
findSingletonChoice (c@(Choice s):xs) | S.size s == 1 = let [x] = S.elems s findSingletonChoice [] = Nothing
in Just (x, Resolved x:xs) findSingletonChoice (x:xs) =
| otherwise = (fmap.fmap) (c:) $ findSingletonChoice xs case x of
findSingletonChoice (x:xs) = (fmap.fmap) (x:) $ findSingletonChoice xs Choice s | S.size s == 1 -> let [r] = S.elems s
findSingletonChoice _ = Nothing in Just (r, Resolved r : xs)
_ -> fmap (\(r, rest) -> (r, x:rest)) $ findSingletonChoice xs
resolve' :: Ord a => [Resolve a] -> Maybe [Resolve a] resolve' :: Ord a => [Resolve a] -> Maybe [Resolve a]
resolve' xs = do resolve' xs = do
(x, xs') <- findSingletonChoice xs (r, xs') <- findSingletonChoice xs
return $ map (dropChoice x) xs' return $ map (dropChoice r) xs'
where dropChoice x (Choice s) = Choice (S.delete x s) where dropChoice x (Choice s) = Choice (S.delete x s)
dropChoice _ r = r dropChoice _ y = y
part1 :: Input -> Int part1 :: Input -> Int
part1 Input { fields, otherTickets } = sum . filter (not . matchesAnyField fields) . concat $ otherTickets part1 Input { fields, otherTickets } = sum . filter (not . matchesAnyField fields) . concat $ otherTickets