Done again with brute force

diff --git a/advent-of-code21.cabal b/advent-of-code21.cabal
index 82dc2ad630bf495c24ba6058ee7806c43d310853..c3b897768f6ff9438bc7e838bce5205876eac704 100644 (file)
--- a/advent-of-code21.cabal
+++ b/advent-of-code21.cabal
@@ -119,3 +119,8 @@ executable advent08
   import: common-extensions, build-directives
   main-is: advent08/Main.hs
   build-depends: text, attoparsec, containers
+
+executable advent08a
+  import: common-extensions, build-directives
+  main-is: advent08/Main-longwinded.hs
+  build-depends: text, attoparsec, containers

diff --git a/advent08/Main-longwinded.hs b/advent08/Main-longwinded.hs
new file mode 100644 (file)
index 0000000..5e51f28
--- /dev/null
+++ b/advent08/Main-longwinded.hs
@@ -0,0 +1,138 @@
+-- Writeup at https://work.njae.me.uk/2021/12/04/advent-of-code-2021-day-4/
+
+import Data.Text ()
+import qualified Data.Text.IO as TIO
+
+import Data.Attoparsec.Text
+import Control.Applicative
+
+import Data.List hiding ((\\))
+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
+
+countUniques (Display _ outputs) = length uniqLens
+  where outLens = map length outputs
+        uniqLens = outLens `intersect` uniqueLengths
+
+uniqueLengths = [2, 3, 4, 7]
+
+segmentNames = S.fromList "abcdefg"
+
+digitSegments :: DigitSegments
+digitSegments = M.fromList
+  [ (S.fromList [Seg1, Seg2, Seg3, Seg5, Seg6, Seg7], '0')
+  , (S.fromList [Seg3, Seg6], '1')
+  , (S.fromList [Seg1, Seg3, Seg4, Seg5, Seg7], '2')
+  , (S.fromList [Seg1, Seg3, Seg4, Seg6, Seg7], '3')
+  , (S.fromList [Seg2, Seg3, Seg4, Seg6], '4')
+  , (S.fromList [Seg1, Seg2, Seg4, Seg6, Seg7], '5')
+  , (S.fromList [Seg1, Seg2, Seg4, Seg5, Seg6, Seg7], '6')
+  , (S.fromList [Seg1, Seg3, Seg6], '7')
+  , (S.fromList [Seg1, Seg2, Seg3, Seg4, Seg5, Seg6, Seg7], '8')
+  , (S.fromList [Seg1, Seg2, Seg3, Seg4, Seg6, Seg7], '9')
+  ]
+
+
+-- combine = M.unionWith intersect
+
+part2 displays = sum $ map decodeOneDisplay displays
+
+decodeOneDisplay display = findCode invAllocation 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
+
+
+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
+
+findDigits :: Encoding -> [[Char]] -> [Char]
+findDigits segmentAssignments codes = map (findDigit segmentAssignments) codes
+
+findCode :: Encoding -> Display -> Int
+findCode segmentAssignments (Display _ codes) = read $ findDigits segmentAssignments codes
+
+
+
+-- Parse the input file
+
+displaysP = displayP `sepBy` endOfLine
+displayP = Display <$> (patternsP <* " | ") <*> patternsP
+
+patternsP = patternP `sepBy` " "
+patternP = many1 letter
+
+-- successfulParse :: Text -> (Integer, [Maybe Integer])
+successfulParse input = 
+  case parseOnly displaysP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right displays -> displays

diff --git a/advent08/Main.hs b/advent08/Main.hs
index 5e51f2852fa3199599160307c369760519ead6fc..6e5c4195adfcd92d9482fec441d4a31c62ba52e2 100644 (file)
--- a/advent08/Main.hs
+++ b/advent08/Main.hs
@@ -4,23 +4,21 @@ 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)
+  deriving (Eq, Ord, Show, Enum, Bounded)
   
 
 main :: IO ()
@@ -29,18 +27,30 @@ main =
       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 :: [Display] -> Int
 part1 displays = sum $ map countUniques displays
 
+part2 :: [Display] -> Int
+part2 displays = sum $ map decodeOneDisplay displays
+
+countUniques :: Display -> Int
 countUniques (Display _ outputs) = length uniqLens
   where outLens = map length outputs
         uniqLens = outLens `intersect` uniqueLengths
 
+uniqueLengths :: [Int]
 uniqueLengths = [2, 3, 4, 7]
 
-segmentNames = S.fromList "abcdefg"
+decodeOneDisplay :: Display -> Int
+decodeOneDisplay display = findCode allocation display
+  where allocation = allocate display
+
+segmentNames :: [Char]
+segmentNames = "abcdefg"
+
+segments :: [Segment]
+segments = [Seg1 .. Seg7]
 
 digitSegments :: DigitSegments
 digitSegments = M.fromList
@@ -56,70 +66,29 @@ digitSegments = M.fromList
   , (S.fromList [Seg1, Seg2, Seg3, Seg4, Seg6, Seg7], '9')
   ]
 
+allocate :: Display -> Encoding
+allocate (Display examples _) = head $ validEncodings
+  where allEncodings = map (\segs -> M.fromList $ zip segmentNames segs) 
+                            $ permutations segments
+        validEncodings = filter (isValidEncoding examples) allEncodings
 
--- combine = M.unionWith intersect
-
-part2 displays = sum $ map decodeOneDisplay displays
+segmentsOfSignal :: Encoding -> [Char] -> S.Set Segment
+segmentsOfSignal encoding signal = S.fromList $ map (encoding ! ) signal
 
-decodeOneDisplay display = findCode invAllocation 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
+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