Haskell Quiz/Secret Santas/Solution Anton
-- Ruby quiz 2 - Haskell solution -- Copyright (C) 2011 Anton Pirogov import Data.List import Data.Function main = do xs <- fmap (mix . prepare . parse) getContents putStr $ format xs parse = map (\(a:b:c) -> (a,b)) . map words . lines prepare = sortBy size . groupBy family . sortBy lastname where lastname = compare `on` snd family = (==) `on` snd size = compare `on` length mix = foldl1 (\a b -> ziprest a b ++ (concat $ zipWith (\x y -> x:[y]) a b)) where ziprest a b = let diff = length b - length a in if diff > 0 then drop (length b - diff) b else drop (length a + diff) a format = unlines . map (\(a,b) -> a++" "++b)
It reads from standard input, splits, sorts and groups by family, then it merges the families by zipping them into each other, starting with the small ones, always prepending the "overhanging" rest members to the result (as zip drops the last elements of the longer list). By prepending the rests its ensured that in the next zipping these members get mixed up too (if possible at all).
Because no additional shuffling of the names is done, the result for a given list is always the same and depends on the name order (as the pre-sorting does not look at the first names), so to get different results, you have to pre-shuffle the list... example usage with shuffling (assuming a unix shell):
shuf namefile | runhaskell rubyquiz2.hs