Day 7 (a complete, b started)

advent-of-code.cabal

 cabal-version:      3.4
 name:               advent-of-code
 version:            0.1.0.0
-synopsis: My 2021 Advent of Code solutions
+synopsis:           My 2021 Advent of Code solutions
 license:            BSD-3-Clause
 license-file:       LICENSE
 author:             Stuart A. Kurtz

src/AOC-08a.hs

 module Main where
 
+-- import Data.Foldable (for_)
+-- import Text.Printf
+
+data Segment = A | B | C | D | E | F | G
+  deriving Show
+type Code = [Segment]
+
+repAssocs :: [(Char,Segment)]
+repAssocs = [('a',A), ('b',B), ('c',C), ('d',D), ('e',E), ('f',F), ('g',G)]
+
+fromRep :: String -> Code
+fromRep = map charRep where
+  charRep ch =  case lookup ch repAssocs of
+    Nothing -> error $ "fromRep: unexpected char:" ++ [ch]
+    Just s -> s
+
+codeAssocs :: [(Int,Code)]
+codeAssocs = fmap fromRep <$> 
+  [ (0,"abcefg")
+  , (1,"cf")
+  , (2,"acdeg")
+  , (3,"acdfg")
+  , (4,"bcdf")
+  , (5,"abdfg")
+  , (6,"abdefg")
+  , (7,"acf")
+  , (8,"abcdefg")
+  , (9,"abcefg")
+  ]
+
+charCode :: Int -> Code
+charCode ch = case lookup ch codeAssocs of
+  Nothing -> error $ "charCode: unexpected code point: " ++ show ch
+  Just c -> c
+
+data Note = Note { observations :: [Code], output :: [Code] }
+  deriving Show
+
+readNote :: String -> Note
+readNote str = Note (fromRep <$> take 10 ws) (fromRep <$> drop 11 ws) where
+  ws = words str
+
+score :: Note -> Int
+score (Note _ out) = length . filter isUniqueCode $ out 
+
+isUniqueCode :: Code -> Bool
+isUniqueCode code = length code `elem` map codeLength [1,4,7,8] where
+  codeLength = length . charCode
+
 main :: IO ()
-main = pure ()
+main = do
+  notes <- map readNote . lines <$> readFile "data/seven-segment.txt"
+  print . sum . map score $ notes
\ No newline at end of file

src/AOC-08b.hs

 module Main where
 
+import Data.List ((\\))
+-- import Data.Foldable (for_)
+-- import Text.Printf
+
+data Segment = A | B | C | D | E | F | G
+  deriving (Eq,Show)
+type Code = [Segment]
+
+repAssocs :: [(Char,Segment)]
+repAssocs = [('a',A), ('b',B), ('c',C), ('d',D), ('e',E), ('f',F), ('g',G)]
+
+fromRep :: String -> Code
+fromRep = map charRep where
+  charRep ch =  case lookup ch repAssocs of
+    Nothing -> error $ "fromRep: unexpected char:" ++ [ch]
+    Just s -> s
+
+codeAssocs :: [(Int,Code)]
+codeAssocs = fmap fromRep <$> 
+  [ (0,"abcefg")
+  , (1,"cf")
+  , (2,"acdeg")
+  , (3,"acdfg")
+  , (4,"bcdf")
+  , (5,"abdfg")
+  , (6,"abdefg")
+  , (7,"acf")
+  , (8,"abcdefg")
+  , (9,"abcefg")
+  ]
+
+charCode :: Int -> Code
+charCode ch = case lookup ch codeAssocs of
+  Nothing -> error $ "charCode: unexpected code point: " ++ show ch
+  Just c -> c
+
+data Note = Note { observations :: [Code], output :: [Code] }
+  deriving Show
+
+readNote :: String -> Note
+readNote str = Note (fromRep <$> take 10 ws) (fromRep <$> drop 11 ws) where
+  ws = words str
+
+score :: Note -> Int
+score (Note _ out) = length . filter isUniqueCode $ out 
+
+isUniqueCode :: Code -> Bool
+isUniqueCode code = length code `elem` map codeLength [1,4,7,8] where
+  codeLength = length . charCode
+
+oneCode :: [Code] -> Code
+oneCode = head . filter ((==2) . length)
+
+fourCode :: [Code] -> Code
+fourCode = head . filter ((==4) . length)
+
+sevenCode :: [Code] -> Code
+sevenCode = head . filter ((==3) . length)
+
+eightCode :: [Code] -> Code
+eightCode = head . filter ((==7) . length)
+
+descramble:: [Code] -> [Segment]
+descramble cs = [a] where
+  one = oneCode cs
+  four = fourCode cs
+  seven = sevenCode cs
+  eight = eightCode cs
+  a = head $ seven \\ one
+
+
+
 main :: IO ()
-main = pure ()
+main = do
+  notes <- map readNote . lines <$> readFile "data/seven-segment.txt"
+  print . sum . map score $ notes
+

test/seven-segment.txt

+be cfbegad cbdgef fgaecd cgeb fdcge agebfd fecdb fabcd edb | fdgacbe cefdb cefbgd gcbe
+edbfga begcd cbg gc gcadebf fbgde acbgfd abcde gfcbed gfec | fcgedb cgb dgebacf gc
+fgaebd cg bdaec gdafb agbcfd gdcbef bgcad gfac gcb cdgabef | cg cg fdcagb cbg
+fbegcd cbd adcefb dageb afcb bc aefdc ecdab fgdeca fcdbega | efabcd cedba gadfec cb
+aecbfdg fbg gf bafeg dbefa fcge gcbea fcaegb dgceab fcbdga | gecf egdcabf bgf bfgea
+fgeab ca afcebg bdacfeg cfaedg gcfdb baec bfadeg bafgc acf | gebdcfa ecba ca fadegcb
+dbcfg fgd bdegcaf fgec aegbdf ecdfab fbedc dacgb gdcebf gf | cefg dcbef fcge gbcadfe
+bdfegc cbegaf gecbf dfcage bdacg ed bedf ced adcbefg gebcd | ed bcgafe cdgba cbgef
+egadfb cdbfeg cegd fecab cgb gbdefca cg fgcdab egfdb bfceg | gbdfcae bgc cg cgb
+gcafb gcf dcaebfg ecagb gf abcdeg gaef cafbge fdbac fegbdc | fgae cfgab fg bagce
\ No newline at end of file