- 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