[Haskell-beginners] Simplifying code

[Krzysztof Skrzętnicki]

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