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
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