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(a)gmail.com,
Tel: +31727851429
Fax: +31848363080
Skype: edgar.klerks
Website: flatlinerict.nl
Adres: Koelmalaan 258,
1813JD, Alkmaar
Nederland
