4
\$\begingroup\$

I began learning Haskell last week. I wrote the following to get the next lexicographic permutation of a list. It works perfectly but I feel like I'm just writing a c# method. My long list of where commands just feels like an imperative approach. I would appreciate any feedback if this solution is indeed the way most people would write something like this in haskell:

-- Finds the end of a list that is monotonically decreasing (swap)
-- Pivot is the index just before it. (pivot)
-- exchanges the smallest value > pivot in swap with pivot
-- reverses the swap with the pivot in it, and concatenates the new permutation
nextPerm :: (Ord a,Num a) => [a] -> [a]
nextPerm [] = []
nextPerm a = if pivotIndex == (-1) then a 
             else prePivot ++ [swapVal] ++ swapWithPivot
             where
                 swap = foldl (\acc x -> if x<=(last acc) then acc ++ [x] else [x]) [(-1)] a
                 pivotIndex = (length a) - (length swap) - 1
                 prePivot = take pivotIndex a
                 pivotVal = a !! pivotIndex
                 swapVal = foldl1 (\acc x -> if x > pivotVal then x else acc) swap
                 swapWithPivot = insert pivotVal $ delete swapVal $ reverse swap
\$\endgroup\$

2 Answers 2

2
\$\begingroup\$

I'm a beginner at Haskell as well, so take my opinion with a big rock of salt.

nextPerm :: (Ord a, Num a) => [a] -> [a]
nextPerm [] = []
nextPerm a

I wouldn't use a as a type variable and a variable at the same time.
I like to name lists xs, ys, cs, etc. I feel this is more descriptive, and it works well with pattern-matching, e.g. (x:xs), where x is the head of the list, xs is the tail.

swap = foldl (\acc x -> if x <= (last acc) then acc ++ [x] else [x]) [(-1)] a

Here you are going through the list from the front. When you use last, the program has to go through the whole list, because lists are kind of like linked lists, think [1,2,3] = 1 : 2 : 3 : [], so accessing an element takes \$O(n) \$ time. For the same reason, (++) is expensive, while (:) is cheap. Try running swap on a list of \$ 10^5 \$ size; it's slow.

Other than the speed factor, I think your implementation is OK!

If you want to make it faster, first of all you should change swap. For example, first reverse the list, then work on it - as lists are made to be accessed from the front, not the back. Let me show you an improved version of swap along with a few other changes.

nextPerm :: Ord a => [a] -> [a]
nextPerm xs
  | null xs || pivotIndex == -1 = xs
  | otherwise = prePivot ++ swapVal : swapWithPivot
  where pivotIndex = length xs - length swap - 1
        prePivot = take pivotIndex xs
        pivotVal = xs !! pivotIndex
        swapVal = foldl1 (\acc x -> if x > pivotVal then x else acc) swap
        swapWithPivot = insert pivotVal . delete swapVal . reverse $ swap
        swap = reverse . fmap fst 
                       . takeWhile (uncurry (>=)) 
                       . (<*>) zip (\ls -> head ls:ls) 
                       . reverse $ xs

As you can see, this way, you don't even need to restrict yourself to the class Num. To make it even better, figure out how to use span instead of take, and takeWhile. If you do that, you won't even need indexing anymore.
Use Hoogle, play around in ghci, look at types using :t <typename> e.g. :t span - type signatures (and names) will usually tell you what a function does.

Lists are weak at random access, but kind of good at being sliced up; therefore I'd definitely drop the whole indexing thing.

Anyway, I will include how I'd write it, hopefully it'll give you some new ideas.

nextPerm' :: Ord a => [a] -> [a]
nextPerm' = uncurry (++) . uncurry swap
                         . (fmap fst *** fmap fst)
                         . span (uncurry (>=))
                         . (<*>) zip (\ls -> head ls:ls)
                         . reverse
    where swap rpost [] = ([], rpost)
          swap rpost (pivot:rpre) = (reverse rpre, ins . span (<= pivot) $ rpost)
              where ins (le,[])   = le ++ [pivot]
                    ins (le,a:as) = a:le ++ pivot:as

If you want to test an implementation, issue

(sort . permutations $ [1,2,3,4,5]) == (take 120 $ iterate nextPerm [1,2,3,4,5])

If it works, the result will be True.

\$\endgroup\$
2
  • \$\begingroup\$ Thanks for the response. There is a lot of great information here and was able to learn a quite a bit , especially about currying. Though I hate to say the code is bugged. Even your example. 625431->631245. Its because you only did half the pivot swap.. You stuck it in the post, but forgot to take its "swap" and stick it in the pre. I was able to fix it and add a stop (your function just takes [3,2,1] back to [1,23] \$\endgroup\$ Commented Apr 5, 2017 at 10:44
  • \$\begingroup\$ @TonyChamberlain I shouldn't code or review code during the night. Sorry about that. Anyway, the codes now work, thanks for pointing out the errors. \$\endgroup\$ Commented Apr 5, 2017 at 14:55
1
\$\begingroup\$

It's not so much the amount of bindings in your where clause, but rather some other pitfalls. For example, last acc will traverse the whole accumulated list, which is rather inefficient. Also, (++) takes linear time. We can remove both from your swap by building the acc in reverse:

swap = foldl (\acc@(ac:_) x -> if x <= ac then x : acc else [x]) [negate 1] a

That brings us to naming. Lists are usually called xs (for xses). That's just a minor nitpick, although it would make place for a as the first element of the accumulator.

Either way, the Num constraint should not be necessary. (-1) might even lead to a wrong swap if all other values are lesser, e.g.

nextPerm [(-5)..(-2)] -- your result will contain `-1`.

So instead, let us use foldl1:

swap = foldl1 (\acc@(ac:_) [x] -> if x <= ac then x : acc else [x]) (map return xs)

For the pivot value, you could use splitAt instead:

By the way, swap == rest, but now reversed, since the accumulator in swap is now reversed. Therefore, we need to reverse swap for swapVal or use foldr1 here. However, head . filter covers your intend best, so I recommend that instead. We end up with

nextPerm :: (Ord a) => [a] -> [a]
nextPerm [] = []
nextPerm xs = if pivotIndex == (-1) then xs
              else prePivot ++ [swapVal] ++ swapWithPivot
  where
    swap = foldl1 (\acc@(a:_) [x] -> if x <= a then x : acc else [x]) (map return xs)
    pivotIndex               = (length a) - (length swap) - 1
    (prePivot, pivotVal : _) = splitAt pivotIndex a
    swapVal                  = head . filter (> pivotVal) $ swap
    swapWithPivot            = insert pivotVal $ delete swapVal $ swap

However, all of this isn't very easy to read. It gets a lot easier if we reverse the list beforehand. But that's left for an exercise.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.