1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
{-# OPTIONS -Wno-incomplete-uni-patterns #-}
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])
|