# Haskell Quiz/Secret Santas/Solution Anton

### From HaskellWiki

< Haskell Quiz | Secret Santas(Difference between revisions)

(One intermediate revision by one user not shown) | |||

Line 1: | Line 1: | ||

+ | [[Category:Haskell Quiz solutions|Secret Santas]] | ||

<haskell> | <haskell> | ||

-- Ruby quiz 2 - Haskell solution | -- Ruby quiz 2 - Haskell solution | ||

Line 18: | Line 19: | ||

mix = foldl1 (\a b -> ziprest a b ++ (concat $ zipWith (\x y -> x:[y]) a b)) | 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 | where ziprest a b = let diff = length b - length a in | ||

− | if diff | + | if diff > 0 |

then drop (length b - diff) b | then drop (length b - diff) b | ||

else drop (length a + diff) a | else drop (length a + diff) a |

## Latest revision as of 00:07, 12 August 2011

-- 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`