Google Code Jam/Ugly Numbers

import Prelude hiding (lookup) import Data.Map hiding (map) import Control.Arrow ((&&&)) import Data.List hiding (insert,lookup) import Text.Printf import Control.Applicative hiding (empty) uglys = [2,3,5,7] :: [Integer] compress = flip mod $ product uglys ugly x = any ((==0) . mod x) $ uglys type RCache = Map Integer Integer -- use a Map to have a nice unionsWith, when summarizing number counts type Cache = Map String RCache -- memoized number counts for strings date :: (Integer -> Integer) -> Cache -> String -> Cache date comp cache ct@(c:cs) = insert ct (unionsWith (+) ns) cache where ns = do (t,i) <- uncurry zip $ (tails &&& inits) cs let n = read $ c:i case lookup t cache of Nothing -> [singleton (comp n) 1] Just r -> map (\f -> mapKeys (comp . f n) r) [(-),(+)] solution :: String -> Integer solution x = sum . elems . filterWithKey (const . ugly) $ cache x ! x where cache = foldl (date compress) empty . tail . reverse . tails main = enumFromTo (1::Int) <$> readLn >>= mapM_ doCase where doCase i = getLine >>= putStrLn . printf "Case #%d: %d" i . solution