[Haskell-beginners] Simplifying code

[Patrick LeBoutillier]

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 <edgar.klerks at gmail.com> wrote:
> 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 at nana
> ban at na
> b at n@na
> banan@
> b at nan@
> ban at n@
> b at 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 at gmail.com,
> Tel: +31727851429
> Fax: +31848363080
> Skype: edgar.klerks
> Website: flatlinerict.nl
> Adres: Koelmalaan 258,
> 1813JD, Alkmaar
> Nederland
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
>



-- 
=====================
Patrick LeBoutillier
Rosemère, Québec, Canada