Newer clumps.hs

gistfile1.txt

clumps :: (Num a, Ord a) => GHC.Int.Int64 -> GHC.Int.Int64 -> a -> T.Text -> [T.Text]
clumps k l t text = M.keys $ M.filter (>=t) $ (\(m,_,_,_) -> m) $ T.foldl'
                    (\x y -> slideDrop $ slideInsert x y)
                    (M.singleton prefix 1, prefix, prefix, k)
                    text'
    where
      (prefix, text') = T.splitAt k text
      slideInsert (m, word, window, delay) c = let wtail = (snd . fromJust . T.uncons) word
                                                   word' = T.snoc wtail c
                                               in  (M.alter increment word' m, word', T.snoc window c, min l (delay + 1))

      increment Nothing  = Just 1
      increment (Just n) = if n > t
                           then Just n
                           else Just (n+1)

      slideDrop (m, word, window, delay)
                | delay < l = (m, word, window, delay)
                | otherwise = let falloff = T.take k window
                                  window' = snd $ fromJust $ T.uncons window
                              in (M.alter decrement falloff m, word, window', delay)

      decrement Nothing  = Nothing
      decrement (Just 1) = Nothing
      decrement (Just n) = if n <= t
                           then Just (n-1)
                           else Just n



main :: IO ()
main = do
  text <- TI.getContents
  let result = clumps 9 500 3 text
  mapM_ TI.putStrLn result