Hi,
I think that this is a case where you have to let the recursion do the
work for you.
Here is a solution, although it seems it generates the permutations in
a different order
than yours:
import Data.Maybe
leet = [('s', '$'), ('t', '+'), ('l', '|'), ('o', '0'), ('e', '3'),
('a', '@'), ('v', '^')]
mutateWords :: [String] -> [[String]]
mutateWords = map mutateWord
mutateWord :: String -> [String]
mutateWord [] = [[]]
mutateWord (c:cs) = concat . map perms $ mutateWord cs
where perms cs' = map (: cs') $ mutateLetter c
-- Returns a list of possible characters for c
mutateLetter :: Char -> [Char]
mutateLetter c = c : (maybeToList $ lookup c leet)
Basically, in mutateLetter you generate a list of possible letters.
For a char that
stays the same, we return [c]. For a char that has a substitution in
the leet list,
we return [c, c'].
Then in mutateWord we process the first letter, generate all the
choices and prepend
them to all the choices for the rest of the word.
Patrick
On Tue, Feb 9, 2010 at 3:11 PM, edgar klerks
Hi All,
I wrote a program which permutates a list words with some rules. For example if I feed it a list like:
banana waterloo vraag
It gives back the list:
banana b@nana ban@na b@n@na banan@ b@nan@ ban@n@ b@n@n@ waterloo wa+erloo water|oo waterl0o etc
However I have the feeling I am doing things to complicated. I am still a beginner. Would someone like to help me simplify somethings. If you think this is inappropriate please state also. I am not offended then. I understand you are offering your spare time to help me.
The first thing I don't get is this. I recognize some things could be rewritten with a bind operator (because of the concat $ fmap), but I am puzzled how:
mutateWords :: [Char] -> [[Char]] mutateWords word = nub.concat $ fmap snd <$> fmap unzip <$> ( foldr(\x z -> let char = snd x nm = number word lst = fst x in (insertAt char nm <$> lst) : z ) [[]] $ mw word )
Here is the full code:
import Data.List import System import System.IO import Control.Applicative
---CONFIG section
leat = ['s' ==> '$', 't' ==> '+', 'l' ==> '|', 'o' ==> '0','e' ==> '3', 'a' ==> '@', 'v' ==> '^']
leata = fst.unzip $ leat leatb = snd.unzip $ leat
-- Perl like assoc lists infixl 1 ==> a ==> b = (a, b)
-- Flipped fmap sometimes nicer infixl 4 <$$>
xs <$$> f = f <$> xs
-- first I need to find the positions of the mutatable charachters. findPositions :: [Char] -> [[Int]] findPositions xs = take (length index) $ index <*> [xs] where index = elemIndices <$> leata
-- And generate all subsequences findSubSeq :: [Char] -> [[[Int]]] findSubSeq = fmap subsequences <$> findPositions
-- Only change elements which needs to be changed insertAt :: Char -> [(Int, Char)] -> [Int] -> [(Int,Char)] insertAt c xs ps = xs <$$> (\x -> if (fst x) `elem` ps then (fst x , c) else x ) -- Couples character to mutable positions mw word = (findSubSeq word) `zip` leatb
number = zip [0..]
mutateWords :: [Char] -> [[Char]] mutateWords word = nub.concat $ fmap snd <$> fmap unzip <$> ( foldr(\x z -> let char = snd x nm = number word lst = fst x in (insertAt char nm <$> lst) : z ) [[]] $ mw word )
generateAll :: [Char] -> [[Char]] generateAll word = g lea $ mutateWords word where g 0 words = words g n words = g (n - 1) (nub $ words >>= mutateWords ) lea = length leata main = do filename <- getArgs wordlist <- readFile $ filename !! 0 let a = (words wordlist) >>= generateAll mapM_ putStrLn a
-- Flatliner ICT Service, Email: Edgar.klerks@gmail.com, Tel: +31727851429 Fax: +31848363080 Skype: edgar.klerks Website: flatlinerict.nl Adres: Koelmalaan 258, 1813JD, Alkmaar Nederland
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners
-- ===================== Patrick LeBoutillier Rosemère, Québec, Canada