advent-2021/8/solution.hs

87 lines
2.6 KiB
Haskell
Raw Normal View History

2021-12-09 21:28:41 +01:00
import Data.List
import Data.List.Split
import Debug.Trace
main :: IO ()
main = do
input <- readFile "8/input.txt"
let x = map parse $ lines input
-- Problem 1
print $ f x
-- Problem 2
print $ g x
where
f = length . filter (`elem` [2, 3, 4, 7]) . map length . (>>= snd)
g x = sum $ zipWith (curry decode) (map snd x) (map deduce x)
-- | Parse a line to a tuple of signal values and output values.
-- | The signal values and output values are sorted.
parse :: String -> (Signal, Output)
parse s = let (a, b) = break (== '|') s
signal = map sort $ filter (/= "|") $ words a
output = map sort $ filter (/= "|") $ words b in
(signal, output)
type Signal = [String]
type Output = [String]
type Mapping = [Result]
data Result = Missing String
| Matched Int String
deriving
Show
-- | Extract the segment combination belonging to the given number.
get :: Mapping -> Int -> String
get m i = head [ s | Matched n s <- m, n == i ]
-- | Extract the number belonging to the given segment combination.
seg :: Mapping -> String -> Int
seg m v = head [ n | Matched n s <- m, s == v ]
-- | Deduce what segments correspond to which number. The number
-- | the combination belongs to is its index.
deduce :: (Signal, Output) -> Mapping
deduce (signal, output) = foldl match (map Missing signal) [ 1, 7, 4, 8, 9, 6, 0, 5, 3, 2 ]
-- | Use the given `Mapping` to match an unmatched set of segments
-- | to the given number.
match :: Mapping -> Int -> Mapping
match m n = match' n pred <$> m
where
pred = matcher n m
match' _ _ v @ (Matched _ _) = v
match' n condition (Missing a)
| condition a = Matched n a
| otherwise = Missing a
-- | Map a number to a function that can be used to match that number.
matcher :: Int -> Mapping -> (String -> Bool)
matcher 0 = p
where p _ s = length s == 6
matcher 1 = p
where p _ s = length s == 2
matcher 2 = p
where p _ _ = True
matcher 3 = p
where p m s = s == (s `intersect` get m 9)
matcher 4 = p
where p _ s = length s == 4
matcher 5 = p
where p m s = s == (s `intersect` get m 6)
matcher 6 = p
where p m s = length s == 6 && get m 1 /= (get m 1 `intersect` s)
matcher 7 = p
where p _ s = length s == 3
matcher 8 = p
where p _ s = length s == 7
matcher 9 = p
where p m s = get m 4 == get m 4 `intersect` s
-- | Given a list of output values and a segment mapping,
-- | decode what the output reads.
decode :: (Output, Mapping) -> Int
decode (output, mapping) = read (concatMap (show . seg mapping) output)