Permutation implementation in Haskell
I was trying to implement permutation of a list in Haskell. The idea for permutations is this:
The base cases are when list length is 0 and 1 which is the list itself, and when size is 2, the permutation gives the list itself along with swapped elements.
Now, given a list [a,b,c,d] we permute [b,c,d] and append with a. and we change our list to have b in the first like [b,a,c,d] and permute [a,c,d] and so on, recursively.
So far, I have done the following code in Haskell. Which perfectly works. But I am not satisfied with the level of 'haskell-ness' that this contains. I would like to have some hints on how to make this more readable and efficient in haskell. Thanks in advance. The code is below:
-- swap the first element of a list with the element at the index
swapFirstWith index l | index == 0 = l
| otherwise = [l!!index]
++ (take (index-1) (tail l))
++ [head l]
++ (drop (index+1) l)
permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations [a] = [[a]]
permutations [a,b] = [[a,b], [b,a]]
permutations lst = foldl (++) [] (map (x-> miniperms x) swappedList)
where miniperms l = map (x-> (head l): x) $ permutations (tail l)
swappedList = map ((i, x) -> swapFirstWith i lst) (zip [0..] lst)
main = do
putStrLn $ show $ perms
putStrLn $ show $ length perms
where lst = [1,2,3,4,5,6,7,8,9]
perms = permutations lst
Avoid !!,head,tail in favor of pattern matching. Such functions are partial, and can crash your program when the list is too short. Pattern matching (when exhaustive) has no such issues.
length, take, drop are often better left unused.
Instead, let us consider the simple recursion:
perms :: [a] -> [[a]]
perms [] = [[]]
perms (x:xs) = doSomething x (perms xs)
How to turn perms xs into perms (x:xs) ? In each permutation p of xs , we need to insert x at any possible point of p . We get
perms :: [a] -> [[a]]
perms [] = [[]]
perms (x:xs) = [ p' | p <- perms xs, (use insert here) ]
where inserting at all points is done as follows
insert :: a -> [a] -> [[a]]
insert x [] = [[x]]
insert x (y:ys) = ... -- todo
I'll leave to you to complete the code.
With
picks :: [t] -> [([t], t)]
picks [] = []
-- picks [x] = [([],x)]
picks (x:xs) = [(xs,x)] ++ [(x:ys,y) | (ys,y) <- picks xs]
it is, straightforwardly,
perms :: [t] -> [[t]]
perms [] = [[]]
perms xs = -- [(x:zs) | (ys,x) <- picks xs, zs <- perms ys]
do
(ys,x) <- picks xs -- pick an element, any element
zs <- perms ys -- permute what's left
return (x:zs) -- and put them together
edit: The repetitive pattern of creating and passing around the updated domain suggests that we can do better, ie make it so that the correct domains are passed around automatically behind the scenes for us, as a part of this specific computational model's "pipeline", as it were.
Right now we have to worry about making a mistake, to name the interim domains explicitly, and to be extra careful to pass the correct variable around as the domain to be used. It's good to have these worries taken care of automatically for us.
Specific notions of computation are captured with a specific instance of a Monad type class.
With the help of "unique selection" monad from an answer by Louis Wasserman,
newtype UniqueSel t a = UniqueSel {runUS :: [t] -> [ ([t], a) ] }
-- domain updated_dom, result
instance Functor (UniqueSel t) where
fmap = liftM
instance Applicative (UniqueSel t) where
pure a = UniqueSel ( choices -> [(choices, a)]) -- unchanged domain
(<*>) = ap
instance Monad (UniqueSel t) where
return = pure
m >>= k = UniqueSel ( choices -> [ r | (cs, a) <- runUS m choices,
r <- runUS (k a) cs ])
we could re-write the above list-based do code as UniqueSel -based do code,
perm = do { x <- UniqueSel picks ; xs <- perm ; return (x:xs) }
where all the interim domain tracking variables have just disappeared! The nature of what we're doing here has become much clearer and more apparent. There's no distractions anymore.
This last code snippet won't work though, as we don't guard against making a selection from an empty domain, which will happen and will effectively abort all computations, producing just [] in the end. We need to return an [] as the result for the empty domains, ourselves.
We could introduce new "primitive" action in our little uniquely-selecting computations language, to bring the hidden choices into our universe, with choices = UniqueSel (cs -> [(cs, cs)]) ; and branch on the empty domain, like
perm = do { cs <- choices ; if (null cs) then return [] else
do { x <- UniqueSel picks ; xs <- perm ; return (x:xs) } }
and run this computation description that we've built, by using perms = map snd . runUS perm perms = map snd . runUS perm ; but this pattern is already captured for us in the standard library, in the module Control.Monad , as the function sequence ; so we can just define
perms :: [t] -> [[t]]
perms = map snd . (runUS =<< sequence . (UniqueSel picks <$))
-- perms xs = map snd $ runUs (sequence [UniqueSel picks | _ <- xs]) xs
-- = ..... (replicateM (length xs) (UniqueSel picks)) xs
This runs the input through the sequence of picks of the same length as the input.
Indeed, to permute an n -long list is to make n arbitrary selections from the ever shrinking pool of possible choices.
下一篇: Haskell中的排列实现