User:Gwern/Permutations.hs

From Wikipedia, the free encyclopedia

   module Permute (permutations, generateCaps)
       where
   import Char (toUpper, toLower)
   import Data.List (nub, isInfixOf, sort)
   import Monad (mapM)
   
   ---------------------------------------------------------------------------------------------------------
   -- Full blown permutation. This generates all regular permutations, with regard to position
   permutations :: [a] -> [[a]]
   permutations [x] = [[x]]
   permutations xs =
     [ y : zs | (y,ys) <- selections xs, zs <- permutations ys ]
   
   selections :: [t] -> [(t, [t])]
   selections []     = []
   selections (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- selections xs]
   
   ---------------------------------------------------------------------------------------------------------
   {- Generate *all* permutations of a string w/r/t capitalizations. This does not permute
   in the sense of permutations.
   The nub removes all duplicate sequences. Some things cannot be capitalized. -}
   permuteCap :: String -> [String]
   permuteCap f = nub $ mapM (\x -> [toUpper x, toLower x]) f
   
   {- Given a list of strings, filter out everything that doesn't have them as a substring.
   That is, filterInternal ["oo", "ar"] (permuteCap "foo bar") => ["Foo Bar","Foo bar","foo Bar","foo bar"] -}
   filterInternal :: [String] -> [String] -> [String]
   filterInternal c l = filter (\s -> all (`isInfixOf` s) c) l
   
   {- filterInternal is an improvement over doing it by hand, but we still need to generate the substrings.
   We shall do it in a manner that means we select for capitalization variations only on initial letters. -}
   generateCapsSlow :: String -> [String]
   generateCapsSlow l = sort $ filterInternal (map tail $ words l) (permuteCap l)
   
   -- Obviously we want to be able to do this to a list of words too.
   capsList :: [String] -> [[String]]
   capsList = map (generateCapsQuick)
   
   ---------------------------------------------------------------------------------------------------------
   {- In case you didn't notice, the previous algorithm used in permuteCap generates *all* capitalizations, which is
   a O(n^2) operation! And since generateCapsSlow is just filtering that list, that means that generateCapsSlow is also
    O(n^2). This isn't good for titles of a reasonable length, so we can more directly generate things. It's more gnarly,
   but that's the price you pay for speed. This replacement algorithm is quicker. -}
   generateListCaps :: String -> [[String]]
   generateListCaps a = (\a b -> zipWith (zipWith (++)) (map (map (:[])) a) (repeat b)) b c
                         where b = mapM (\x -> [toUpper (head x), toLower (head x)]) (words a)
                               c = map tail (words a)
   
   -- We'd rather return a list of Strings and not a list of lists of Strings, so wrap unwords around gLC's output.
   generateCapsQuick :: String -> [String]
   generateCapsQuick a = map unwords b
             where b = generateListCaps a
   
    ---------------------------------------------------------------------------------------------------------
   -- What's our default? The quick one, of course.
   generateCaps :: String -> [String]
   generateCaps = generateCapsQuick