Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

Mike's same five digits solution

By: a guest on Mar 31st, 2011  |  syntax: Haskell  |  size: 1.35 KB  |  views: 81  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. {-# LANGUAGE NoMonomorphismRestriction #-}
  2.  
  3. # See http://kernelbob.wordpress.com/2011/03/20/same-five-digits/#about for problem
  4. # statement.
  5. import qualified Data.Map as M
  6. import qualified Data.Set as S
  7.  
  8. squares = map (show . (^2)) [1..]
  9. fiveLong = takeWhile (\ s -> length s < 6) . dropWhile (\ s -> length s < 5)
  10.  
  11. combinationsOf 0 _ = [[]]
  12. combinationsOf _ [] = []
  13. combinationsOf k (x:xs) = map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs
  14.  
  15. countMap :: [String] -> ([String], M.Map Char Char)
  16. countMap triplet = (triplet, M.map (head . show) . M.fromListWith (+) $
  17.                              zip (concat triplet) (repeat 1))
  18.  
  19. counted n = map countMap . combinationsOf n . fiveLong
  20.  
  21. fiveChars  = filter (\ (_, m) -> (== 5) $ M.size m)
  22. diffChars  = filter (\ (_, m) -> (== 5) . S.size . S.fromList $ M.elems m)
  23. sameDigits = filter (\ (_, m) -> S.fromList (M.elems m) == S.fromList (M.keys m))
  24. notSelf    = filter (\ (_, m) -> (== 0) . M.size $ M.filterWithKey (==) m)
  25. findUnique = M.filter (\ t -> length t == 3) . flipSingles . getSingles
  26.   where
  27.     getSingles = map (\ (t, m) -> (t, head . M.keys $ M.filter (== '1') m))
  28.     flipSingles = M.fromListWith (++) . map (\ (t, m) -> (m, t))
  29.  
  30. filterSeq = findUnique . notSelf . sameDigits . diffChars . fiveChars
  31.  
  32. main = do
  33.   (putStrLn . show . head . M.elems . filterSeq . counted 3) squares