Created
May 1, 2022 18:03
-
-
Save instinctive/6883a5a38b47fade5a3af229ecf4dd6d to your computer and use it in GitHub Desktop.
Google Code Jam 2022 Round 1C Problem A (Haskell)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- boilerplate elided from gist | |
docase :: Int -> IO () | |
docase i = do | |
printf "Case #%d: " i | |
_ <- getLine | |
ss <- words <$> getLine | |
outimp putStrLn $ solve ss | |
aside (x:_,_) = x | |
bside ( _,x) = x | |
isMono (x:_,y) = x == y | |
merge (aa,a) (bb,b) = (aa <> bb,b) | |
canon xx = go S.empty xx where | |
go _ [] = error "canon: empty list" | |
go _ [x] = Just (xx,x) | |
go s (a:b:cc) | |
| a /= b && S.member b s = Nothing | |
| otherwise = go (S.insert a s) (b:cc) | |
dups = (/=) . length <*> S.size . S.fromList | |
solve ss = traverse canon ss >>= solve' | |
solve' qq | |
| dups (map aside mixed) = Nothing | |
| dups (map bside mixed) = Nothing | |
| otherwise = go [] qmap | |
where | |
(monos,mixed) = partition isMono qq | |
qmap = M.fromListWith (flip merge) $ map f $ monos <> mixed | |
where f q@(x:_,_) = (x,q) | |
go uu qm | |
| not $ S.null start = go uu' qm' | |
| otherwise = canon ans <&> \(s,_) -> s | |
where | |
(ans,_) = foldr1 merge $ M.elems qm <> uu | |
start = foldr S.delete (M.keysSet qm) $ map bside $ M.elems qm | |
a = S.findMin start | |
q = qm M.! a | |
b = bside q | |
(uu',qm') = case M.lookup b qm of | |
Nothing -> (q:uu, M.delete a qm) | |
Just r -> (uu, M.insert a (merge q r) $ M.delete b qm) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment