import Data.List
import Jam
main = jam $ concatMap show . sort . f [] <$> gets
f a "" = a
f a s | 'Z' `elem` s = f (0:a) $ s \\ "ZERO"
| 'W' `elem` s = f (2:a) $ s \\ "TWO"
| 'X' `elem` s = f (6:a) $ s \\ "SIX"
| 'U' `elem` s = f (4:a) $ s \\ "FOUR"
| 'G' `elem` s = f (8:a) $ s \\ "EIGHT"
| 'F' `elem` s = f (5:a) $ s \\ "FIVE"
| 'V' `elem` s = f (7:a) $ s \\ "SEVEN"
| 'O' `elem` s = f (1:a) $ s \\ "ONE"
| 'N' `elem` s = f (9:a) $ s \\ "NINE"
| otherwise = f (3:a) $ s \\ "THREE"
2016 Round 1B
Getting the Digits
Some spelled-out digits contain unique letters. For example, only "ZERO" contains the letter "Z". Thus so long as we see a "Z", we know we can remove "ZERO" from the input and append "0" to the output.
After handling these cases, we find that the remaining spelled-out digits now contain unique letters. For example, once we have rmeoved all "FOUR" strings from the input, the presence of an "F" can only indicate "FIVE".
I could have written the function more succinctly, but in contest conditions I found it was easiest to copy and paste, and edit the changes from line to line by hand.
Close Match
Brute force works great for the small input. We generate a list of all possibilities from replacing each "?" with each digit, which can be expressed succinctly with Haskell’s list monad.
Tuples are automatically sorted by the first element and then the second, which we exploit so our code picks the preferred minimum when there are multiple possibilities.
import Data.List
import Data.Ord
import Jam
main = jam $ do
[x, y] <- map (mapM expand) . words <$> gets
pure $ unwords [minimumBy (comparing (\a -> (diff y a, a))) x,
minimumBy (comparing (\a -> (diff x a, a))) y]
diff as b = minimum $ abs . (read b -) . read <$> as
expand '?' = ['0'..'9']
expand d = [d]
A little recursion solves the large input. We start from the most-significant character of both scores and work our way to the least-significant digits.
If neither of the current character in each score is a question mark, then we simply move on to the next character. Otherwise, at least one of the current char is a question mark. If the parts of the scores we have already processed differ, then our job is easy: to make the final score as close a possible, we replace "?" with "9" for the losing side, and with "0" for the winning side.
This leaves the tough case: the digits of both scores we’ve seen so far match exactly. We lack information to make the right decision, because we have yet to reach to digits of lower significance. Fortunately, there’s only a few possibilities, and we can simply try them all. To be as close as possible, we should choose so the digits of both scores are the same or one apart.
If we can choose both digits, that is, both are ?", then we should try 0 for both, 0 for the Coders and 1 for the Jammers, then lastly 1 for the Coders and 0 for the Jammers, so that we find the preferred minimum when there are multiple possibilities.
If one of the digits is known to be d while the other is "?", then we try
[d - 1, d, d + 1] in that order, again so we find the preferred minimum when
there are multiple possibilities.
We rely on the minimum library function to return the first minimum
found.
import Data.Char
import Data.Bool
import Data.List
import Data.Ord
import Jam
main = jam $ unwords . f ["", ""] . words <$> gets
f acc ["", ""] = acc
f [a, b] [x:xs, y:ys]
| x /= '?' && y /= '?' = c x y
| a < b = c '9' '0'
| a > b = c '0' '9'
| otherwise = g [a, b] [x:xs, y:ys]
where c i j = f [a ++ [bool x i (x == '?')],
b ++ [bool y j (y == '?')]] [xs, ys]
g [a, b] [x:xs, y:ys]
| x == '?' && y == '?' = minDiff [c '0' '0', c '0' '1', c '1' '0']
| y /= '?' = minDiff [c y' y | y' <- smear y]
| x /= '?' = minDiff [c x x' | x' <- smear x]
where c i j = f [a ++ [i], b ++ [j]] [xs, ys]
minDiff = minimumBy $ comparing $ \[a, b] -> abs (read a - read b)
smear c = filter isDigit $ chr <$> [ord c - 1..ord c + 1]
Technobabble
Brute force works well on the small input. The subsequences function
conveniently enumerates all subsets of the topics. We take each one in turn,
and see if can generate the other topics, and return the length of the largest
such subset.
import Data.List import Jam main = jam $ do [n] <- getints es <- map words <$> getsn n pure $ show $ maximum [length s | s <- subsequences es, all (f $ es \\ s) s] f [] topic = False f real topic = not (null a || null b) && a /= b where [a, b] = zipWith elemIndices topic $ transpose real
In my haste, my eye had skipped over the line stipulating that first words are always used as first words and similarly for second words. Luckily the small input caught this, so I was able to correct my program for the large input.
As for the large input, we observe we have a bipartite graph, with the first words on one side and the second words on the other. Then if we take the topics corresponding to a maximal matching (which cover two vertices each), along with one topic for each of the unmatched vertices, we can generate all the other topics. A little thought shows this is optimal, that is, this minimizes the number of real topics.
During the contest, I was unable to find a well-known Haskell library that performs bipartite matching. I began coding one, but I soon decided it would be faster to download code posted to the Haskell-cafe mailing list [see accompanying message]. It worked well for my solution:
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Jam
import MaxMatching
main = jam $ do
[n] <- getints
es <- map words <$> getsn n
let
vcount = sum $ length . nub <$> transpose es
matched = M.size $ matching $ S.fromList $ (\[a, b] -> (a, b)) <$> es
pure $ show $ n - vcount + matched
I do intend to write my own bipartite matching routine in Haskell some day, as it is good exercise.