Hi A few remarks about your code: 1. 'String' is a type synonym for [Char]. It makes types like [[Char]] more readable (at least for me). 2. There is something imperative in the way you code: I think you rely too much on numbers as iterators. You don't have to use numbers to drive the program control flow. Examples: main = do filename <- getArgs wordlist <- readFile $ filename !! 0 Why not: main = do (filename:_) <- getArgs wordlist <- readFile filename Or: main = do filename <- head <$> getArgs wordlist <- readFile filename Another example: generateAll :: String -> [String] generateAll word = g lea $ mutateWords word where g 0 words = words g n words = g (n - 1) (nub $ words >>= mutateWords ) lea = length leata The 'g' function can be rewritten to get rid of the index number. Here is what I got: -- https://mail.google.com/mail/#inbox/126b45c29341640f import System.Environment ( getArgs ) import Control.Applicative ( (<$>) ) import Data.Set (Set) import qualified Data.Set as Set ---CONFIG section type Rule = (Char,Char) infixl 1 ==> a ==> b = (a, b) rules :: [Rule] rules = ['s' ==> '$', 't' ==> '+', 'l' ==> '|', 'o' ==> '0', 'e' ==> '3', 'a' ==> '@', 'v' ==> '^'] nubOrd :: (Ord a) => [a] -> [a] nubOrd = Set.toList . Set.fromList singleton x = [x] -- CORE PART -- we mutate all words, rule at a time. If we run out of rules, we finish. mutateWords :: [Rule] -> String -> [String] mutateWords rules word = foldr (\r acc -> nubOrd (concatMap (applyRule r) acc)) (singleton word) rules -- apply one rule to one word. the result is a list of words. applyRule :: Rule -> String -> [String] applyRule (old,new) wrd = aux wrd where aux [] = [[]] -- we may or may not apply our rule here. aux (c:cs) | c == old = [ c':suf | suf <- aux cs, c' <- [old,new] ] | otherwise = [ c :suf | suf <- aux cs ] main = do (filename:_) <- getArgs wordlist <- words <$> readFile filename let mutated = concatMap (mutateWords rules) wordlist mapM_ putStrLn mutated Best regards Krzysztof Skrzętnicki On Tue, Feb 9, 2010 at 21:11, edgar klerks <edgar.klerks@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@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