X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent08%2FMain.hs;h=1addbe3130e4e8d05fd266108788931b6122b8a9;hb=5906e1d8d0723d8c7e3d97c3a29988723efe2f71;hp=5e51f2852fa3199599160307c369760519ead6fc;hpb=d5831d9eb625db71f085c0daa1956d164078226c;p=advent-of-code-21.git diff --git a/advent08/Main.hs b/advent08/Main.hs index 5e51f28..1addbe3 100644 --- a/advent08/Main.hs +++ b/advent08/Main.hs @@ -1,46 +1,32 @@ --- Writeup at https://work.njae.me.uk/2021/12/04/advent-of-code-2021-day-4/ +-- Writeup at https://work.njae.me.uk/2021/12/09/advent-of-code-2021-day-8/ + import Data.Text () import qualified Data.Text.IO as TIO import Data.Attoparsec.Text -import Control.Applicative +-- import Control.Applicative -import Data.List hiding ((\\)) +import Data.List import qualified Data.Map.Strict as M import Data.Map.Strict ((!)) import qualified Data.Set as S -import Data.Set ((\\)) data Display = Display [String] [String] -- patterns, output deriving (Eq, Show) -type Assignments = M.Map Segment (S.Set Char) -type Encoding = M.Map Char Segment -type DigitSegments = M.Map (S.Set Segment) Char - data Segment = Seg1 | Seg2 | Seg3 | Seg4 | Seg5 | Seg6 | Seg7 - deriving (Eq, Ord, Show) - - -main :: IO () -main = - do text <- TIO.readFile "data/advent08.txt" - let displays = successfulParse text - print $ part1 displays - print $ part2 displays - -- let td = successfulParse "acedgfb cdfbe gcdfa fbcad dab cefabd cdfgeb eafb cagedb ab | cdfeb fcadb cdfeb cdbaf" - -- print $ part2 td - -part1 displays = sum $ map countUniques displays + deriving (Eq, Ord, Show, Enum, Bounded) -countUniques (Display _ outputs) = length uniqLens - where outLens = map length outputs - uniqLens = outLens `intersect` uniqueLengths +type Encoding = M.Map Char Segment +type DigitSegments = M.Map (S.Set Segment) Char -uniqueLengths = [2, 3, 4, 7] +-- some constants +segmentNames :: [Char] +segmentNames = "abcdefg" -segmentNames = S.fromList "abcdefg" +segments :: [Segment] +segments = [Seg1 .. Seg7] digitSegments :: DigitSegments digitSegments = M.fromList @@ -57,71 +43,56 @@ digitSegments = M.fromList ] --- combine = M.unionWith intersect +main :: IO () +main = + do text <- TIO.readFile "data/advent08.txt" + let displays = successfulParse text + print $ part1 displays + print $ part2 displays + +part1 :: [Display] -> Int +part1 displays = sum $ map countUniques displays +part2 :: [Display] -> Int part2 displays = sum $ map decodeOneDisplay displays -decodeOneDisplay display = findCode invAllocation display +countUniques :: Display -> Int +countUniques (Display _ outputs) = length uniqLens + where outLens = map length outputs + uniqLens = outLens `intersect` uniqueLengths + +uniqueLengths :: [Int] +uniqueLengths = [2, 3, 4, 7] + +decodeOneDisplay :: Display -> Int +decodeOneDisplay display = findCode allocation display where allocation = allocate display - invAllocation = invertAssignment allocation - -allocate :: Display -> Assignments -allocate (Display examples _) = assignments6 - where - -- segments 3 and 6 are given by pattern of length 2 (digit 1) - dSegs1 = S.fromList $ head $ filter ((== 2) . length) examples - assignments0 = M.fromList [(Seg3, dSegs1), (Seg6, dSegs1)] - -- segment 1 is the one in pattern of length 3 (digit 7) that's - -- not in segments for digit 1 - dSegs7 = S.fromList $ head $ filter ((== 3) . length) examples - assignments1 = M.insert Seg1 (dSegs7 \\ dSegs1) assignments0 - -- segments 2 and 4 are the ones in pattern of length 4 (digit 4) - -- that aren't in pattern for digit 1 - dSegs4 = (S.fromList $ head $ filter ((== 4) . length) examples) \\ dSegs1 - -- segments 1, 4, 7 are the common ones in digits 2, 3, 5 - dSegs235 = S.fromList $ foldl1' intersect $ filter ((== 5) . length) examples - -- segment 4 is the common one with digit 4 - seg4 = dSegs235 `S.intersection` dSegs4 - -- segment 2 is the other one from digit 4 - seg2 = dSegs4 \\ seg4 - assignments2 = M.union (M.fromList [(Seg2, seg2), (Seg4, seg4)]) assignments1 - -- we now know segments 1 and 4, so deduce segment 7 - seg7 = dSegs235 \\ (S.union (assignments2!Seg1) (assignments2!Seg4)) - assignments3 = M.union (M.singleton Seg7 seg7) assignments2 - -- of the 5-segment digits, segment 2 only in digit 5 - seg2c = head $ S.toList seg2 - dSegs5 = S.fromList $ head $ filter (elem seg2c) $ filter ((== 5) . length) examples - -- remove known values of segments 1, 2, 4, 7 - segs1247 = S.unions $ M.elems $ assignments3 `M.restrictKeys` (S.fromList [Seg1, Seg2, Seg4, Seg7]) - -- segs1247 = S.unions [assignments3!Seg1, assignments3!Seg2, - -- assignments3!Seg4, assignments3!Seg7] - -- what's left is segment 6 - seg6 = dSegs5 \\ segs1247 - assignments4 = M.insert Seg6 seg6 assignments3 - -- segment 3 can't be the same allocation as segment 6 - assignments5 = M.insert Seg3 ((assignments4!Seg3) \\ seg6) assignments4 - -- segment 5 is the only one left - seg5 = segmentNames \\ (S.unions $ M.elems assignments5) - assignments6 = M.insert Seg5 seg5 assignments5 - - -invertAssignment assignment = M.foldrWithKey inv1 M.empty assignment - where inv1 seg vals invMap = M.insert (head $ S.elems vals) seg invMap + + + +allocate :: Display -> Encoding +allocate (Display examples _) = head $ validEncodings + where allEncodings = map (\segs -> M.fromList $ zip segmentNames segs) + $ permutations segments + validEncodings = filter (isValidEncoding examples) allEncodings + +segmentsOfSignal :: Encoding -> [Char] -> S.Set Segment +segmentsOfSignal encoding signal = S.fromList $ map (encoding ! ) signal + +isValidEncoding :: [[Char]] -> Encoding -> Bool +isValidEncoding examples encoding = + all (\e -> M.member e digitSegments) exampleSegments + where exampleSegments = map (segmentsOfSignal encoding) examples findDigit :: Encoding -> [Char] -> Char -findDigit segmentAssignments code = digitSegments ! segments - where codeSet = S.fromList code - segmentMap = M.restrictKeys segmentAssignments codeSet - segments = S.fromList $ M.elems segmentMap +findDigit encoding code = digitSegments ! (segmentsOfSignal encoding code) findDigits :: Encoding -> [[Char]] -> [Char] -findDigits segmentAssignments codes = map (findDigit segmentAssignments) codes +findDigits encoding codes = map (findDigit encoding) codes findCode :: Encoding -> Display -> Int -findCode segmentAssignments (Display _ codes) = read $ findDigits segmentAssignments codes - - +findCode encoding (Display _ codes) = read $ findDigits encoding codes -- Parse the input file