Compare commits
No commits in common. "deb81d4e1278dfdf03404d49ba5dd2803371ad27" and "90e7cb78bd3fd9daec628f44fd7a4134ec821240" have entirely different histories.
deb81d4e12
...
90e7cb78bd
2 changed files with 15 additions and 15 deletions
|
@ -5,7 +5,6 @@ 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
|
||||||
|
@ -27,7 +26,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 . findIndices (==c) . reverse $ mask
|
let extractMask c = foldl setBit zeroBits . map fst . filter ((==c) . snd) . enumerate 0 . reverse $ mask
|
||||||
return $ Mask { set = extractMask '1'
|
return $ Mask { set = extractMask '1'
|
||||||
, clear = extractMask '0'
|
, clear = extractMask '0'
|
||||||
, dontcare = extractMask 'X'
|
, dontcare = extractMask 'X'
|
||||||
|
|
|
@ -53,32 +53,33 @@ 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`) . valids) fields
|
matchesAnyField fields n = any (n `S.member`) . map valids $ fields
|
||||||
|
|
||||||
iterateUntilNothing :: (a -> Maybe a) -> a -> a
|
iterateUntilDone :: (a -> Maybe a) -> a -> a
|
||||||
iterateUntilNothing f x = maybe x (iterateUntilNothing f) $ f x
|
iterateUntilDone f x = case f x of
|
||||||
|
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 . iterateUntilNothing resolve' . map (Choice . S.fromList)
|
resolve = sequence . map fromResolved . iterateUntilDone 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 [] = Nothing
|
findSingletonChoice (c@(Choice s):xs) | S.size s == 1 = let [x] = S.elems s
|
||||||
findSingletonChoice (x:xs) =
|
in Just (x, Resolved x:xs)
|
||||||
case x of
|
| otherwise = (fmap.fmap) (c:) $ findSingletonChoice xs
|
||||||
Choice s | S.size s == 1 -> let [r] = S.elems s
|
findSingletonChoice (x:xs) = (fmap.fmap) (x:) $ findSingletonChoice xs
|
||||||
in Just (r, Resolved r : xs)
|
findSingletonChoice _ = Nothing
|
||||||
_ -> 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
|
||||||
(r, xs') <- findSingletonChoice xs
|
(x, xs') <- findSingletonChoice xs
|
||||||
return $ map (dropChoice r) xs'
|
return $ map (dropChoice x) xs'
|
||||||
where dropChoice x (Choice s) = Choice (S.delete x s)
|
where dropChoice x (Choice s) = Choice (S.delete x s)
|
||||||
dropChoice _ y = y
|
dropChoice _ r = r
|
||||||
|
|
||||||
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
|
||||||
|
|
Loading…
Reference in a new issue