1 files changed, 57 insertions, 0 deletions
diff --git a/2021/8.hs b/2021/8.hs
new file mode 100644
index 0000000..7876aef
--- /dev/null
+++ b/2021/8.hs
@@ -0,0 +1,57 @@
+module Main where
+
+import qualified Data.Array as A
+import Data.List
+import Data.Maybe
+
+import Input
+import Util
+
+
+-- Mapping from character (a..g) to position (0..6).
+--  00
+-- 1  2
+--  33
+-- 4  5
+--  66
+type Mapping = A.Array Char Int
+
+-- Mappings from position (0..6) to whether that component is on.
+type Display = A.Array Int Bool
+
+digits :: [Display]
+digits = [dig 1 1 1 0 1 1 1
+         ,dig 0 0 1 0 0 1 0
+         ,dig 1 0 1 1 1 0 1
+         ,dig 1 0 1 1 0 1 1
+         ,dig 0 1 1 1 0 1 0
+         ,dig 1 1 0 1 0 1 1
+         ,dig 1 1 0 1 1 1 1
+         ,dig 1 0 1 0 0 1 0
+         ,dig 1 1 1 1 1 1 1
+         ,dig 1 1 1 1 0 1 1]
+  where dig a b c d e f g = A.listArray (0, 6) (map toEnum [a, b, c, d, e, f, g])
+
+render :: [Char] -> Mapping -> Display
+render cs mp = A.accumArray (flip const) False (0, 6) [(mp A.! c, True) | c <- cs]
+
+whichDigit :: [Char] -> Mapping -> Maybe Int
+whichDigit cs mp = findIndex (== render cs mp) digits
+
+allMappings :: [Mapping]
+allMappings = map (A.listArray ('a', 'g')) (permutations [0..6])
+
+verifyMapping :: [[Char]] -> Mapping -> Bool
+verifyMapping ws mp = isJust (traverse (`whichDigit` mp) ws)
+
+observeToMapping :: [[Char]] -> Mapping
+observeToMapping ws = fromJust (find (verifyMapping ws) allMappings)
+
+decode :: Mapping -> [[Char]] -> Int
+decode mp ws = sum (zipWith (*) [1000,100,10,1] (fromJust (traverse (`whichDigit` mp) ws)))
+
+main :: IO ()
+main = do
+    inp <- map (\l -> let a :| b:_ = splitOn (== '|') l in (words a, words b)) <$> getInput 8
+    print (sum [length (filter ((`elem` [2,3,4,7]) . length) ws) | ws <- map snd inp])
+    print (sum [decode (observeToMapping obs) ws | (obs, ws) <- inp])