never executed always true always false
1 {-# LANGUAGE DeriveAnyClass #-}
2 {-# LANGUAGE DeriveGeneric #-}
3 {-|
4 Module: Y2021.D08
5 Description: Advent of Code 2021 Day 08 Solutions.
6 License: MIT
7 Maintainer: @tylerjl
8
9 Solutions to the 2021 day 08 set of problems for <adventofcode.com>.
10 -}
11 module Y2021.D08
12 ( part8A
13 , part8B
14 , parse8
15 , solve8A
16 )
17 where
18
19 import Control.Applicative
20 import Control.DeepSeq (NFData)
21 import Data.Attoparsec.Text hiding (take)
22 import Data.Either.Utils (fromRight)
23 import Data.HashMap.Strict (HashMap)
24 import Data.Hashable (Hashable)
25 import Data.List (sort)
26 import Data.Map.Strict (Map)
27 import Data.Maybe (mapMaybe)
28 import Data.Monoid
29 import Data.Text (Text)
30 import GHC.Generics (Generic)
31
32 import qualified Data.HashMap.Strict as HM
33 import qualified Data.Map.Strict as M
34
35 -- |Guess I'll use a sum type for this
36 data Signal = SigA | SigB | SigC | SigD | SigE | SigF | SigG
37 deriving (Bounded, Enum, Generic, Hashable, Eq, Ord, Show, NFData)
38
39 -- |Just a type alias for readability.
40 type SignalSequence = [Signal]
41 -- |Just a type alias for readability.
42 type Entry = ([SignalSequence], [SignalSequence])
43 -- |Just a type alias for readability.
44 type SignalEntries = [Entry]
45
46 -- |Solve part A
47 part8A :: Text -> Int
48 part8A = solve8A . parse8
49
50 -- |This one is for benching apart from the parsing overhead.
51 solve8A :: [(a, [SignalSequence])] -> Int
52 solve8A = length . filter part8APredicate . concatMap snd
53
54 -- |Our simple predicate for part A per the instructions.
55 part8APredicate :: SignalSequence -> Bool
56 part8APredicate (length -> size)
57 = size == 2 || size == 4 || size == 3 || size == 7
58
59 -- |Solve part B
60 part8B :: Text -> Int
61 part8B = sum . map (uncurry freqDecode) . parse8
62
63 -- |This gets run for each line of problem input. Take the scrambled numbers, a
64 -- list of digits to decode, and: figure out the mapping to the real signals,
65 -- replace the signals in the digit input, and then turn them into numbers and
66 -- sum them.
67 freqDecode :: [SignalSequence] -> [SignalSequence] -> Int
68 freqDecode (composeCodes -> mappings) =
69 signalSum . mapMaybe (flip HM.lookup sigMap . sort . translate)
70 where
71 translate signals = mapMaybe (`M.lookup` mappings) signals
72
73 -- |Take a scrambled input, and hand back what the mapping for each of its
74 -- "wrong" inputs are for the real signals.
75 composeCodes :: [SignalSequence] -> Map Signal Signal
76 composeCodes = M.compose freqGolden . invertMap . freqMap
77
78 -- |Utility function; take a map and invert the key/values
79 invertMap :: Ord b => Map a b -> Map b a
80 invertMap = M.fromList . map (\(x, y) -> (y, x)) . M.toList
81
82 {-|This is where the bulk of the brain wrinkling takes place.
83
84 First, accept scrambled input and run `occurrences` across it, which makes a way
85 to uniquely identify the signature for a signal type.
86
87 Then, we zip that with the signal itself, which lets us make a map pointing from
88 the frequency list to the chosen signal. Thus, the key for this map should be
89 the commonality between the puzzle "key", or unscrambled input, and the same
90 frequency function run across scrambled inputs.
91 -}
92 freqMap :: [SignalSequence] -> Map [Int] Signal
93 freqMap = M.fromList . flip zip all' . flip map all' . flip occurrences
94 where
95 all' = [minBound .. maxBound]
96
97 -- |Accept a list of signal sequences, a signal to check, and derive a
98 -- "signature" that indicates a) which coded input it appears in and b) how many
99 -- elements are in that coded input. This ends up creating a unique key that is
100 -- identical to the same result if you run the algorithm across a scrambled
101 -- input.
102 occurrences :: Signal -> [SignalSequence] -> [Int]
103 occurrences signal = sort . map length . filter (signal `elem`)
104
105 -- |Run the fancy `freqMap` over the "known good" set of signals to come up with
106 -- a "key" to use later.
107 freqGolden :: Map [Int] Signal
108 freqGolden = freqMap $ HM.keys sigMap
109
110 -- |The resultant list of integers needs to be adjusted to each's respective
111 -- position in the list (turn them into the right 10's, 100's, etc.)
112 signalSum :: [Int] -> Int
113 signalSum = getSum . mconcat . zipWith pow ([0..] :: [Int]) . reverse
114 where
115 pow n int = Sum $ (10 ^ n) * int
116
117 -- |These are the magic combinations from the puzzle description that indicate
118 -- how sequences of signals map to a digit.
119 sigMap :: HashMap SignalSequence Int
120 sigMap = HM.fromList $ zip
121 [ [SigA, SigB, SigC, SigE, SigF, SigG]
122 , [SigC, SigF]
123 , [SigA, SigC, SigD, SigE, SigG]
124 , [SigA, SigC, SigD, SigF, SigG]
125 , [SigB, SigC, SigD, SigF]
126 , [SigA, SigB, SigD, SigF, SigG]
127 , [SigA, SigB, SigD, SigE, SigF, SigG]
128 , [SigA, SigC, SigF]
129 , [SigA, SigB, SigC, SigD, SigE, SigF, SigG]
130 , [SigA, SigB, SigC, SigD, SigF, SigG]
131 ] [0..]
132
133 -- |Parse puzzle input into a list of `Int`s with faster attoparsec.
134 parse8 :: Text -> SignalEntries
135 parse8 = fromRight . parseOnly parser
136 where
137 parser = entry `sepBy1` endOfLine <* endOfLine
138 entry = (,) <$> pattern' <* string " | " <*> pattern'
139 pattern' = many1 signal `sepBy1` satisfy isHorizontalSpace
140 signal = SigA <$ char 'a'
141 <|> SigB <$ char 'b'
142 <|> SigC <$ char 'c'
143 <|> SigD <$ char 'd'
144 <|> SigE <$ char 'e'
145 <|> SigF <$ char 'f'
146 <|> SigG <$ char 'g'