Permutation to disjoint cycles in Haskell

Question

I was trying to implement permutation to cycles in Haskell without using Monad. The problem is as follow: given a permutation of numbers [1..n], output the correspondence disjoint cycles. The function is defined like

permToCycles :: [Int] -> [[Int]]

For the input:

permToCycles [3,5,4,1,2]

The output should be

[[3,4,1],[5,2]]

By the definition of cyclic permutation, the algorithm itself is straightforward. Since [3,5,4,1,2] is a permutation of [1,2,3,4,5], we start from the first element 3 and follow the orbit until we get back to 3. In this example, we have two cycles 3 -> 4 -> 1 -> 3. Continue to do so until we traverse all elements. Thus the output is [[3,4,1],[5,2]].

Using this idea, it is fairly easy to implement in any imperative language, but I have trouble with doing it in Haskell. I find something similar in the module Math.Combinat.Permutations, but the implementation of function permutationToDisjointCycles uses Monad, which is not easy to understand as I'm a beginner.

I was wondering if I could implement it without Monad. Any help is appreciated.

UPDATE: Here is the function implemented in Python.

def permToCycles(perm):
    pi_dict = {i+1: perm[i]
               for i in range(len(perm))}  # permutation as a dictionary
    cycles = []

    while pi_dict:
        first_index = next(iter(pi_dict))  # take the first key
        this_elem = pi_dict[first_index]  # the first element in perm
        next_elem = pi_dict[this_elem]  # next element according to the orbit

        cycle = []
        while True:
            cycle.append(this_elem)
            # delete the item in the dict when adding to cycle
            del pi_dict[this_elem]
            this_elem = next_elem
            if next_elem in pi_dict:
                # continue the cycle
                next_elem = pi_dict[next_elem]
            else:
                # end the cycle
                break

        cycles.append(cycle)

    return cycles

print(permToCycles([3, 5, 4, 1, 2]))

The output is

[[3,4,1],[5,2]]

I think the main obstacle when implementing it in Haskell is how to trace the marked (or unmarked) elements. In Python, it can easily be done using a dictionary as I showed above. Also in functional programming, we tend to use recursion to replace loops, but here I have trouble with thinking the recursive structure of this problem.

Can you post an implementation in an imperative language? Then we'll be able to help you translate. — Fyodor Soikin, Jan 22 '21 at 02:23

score 2 · Accepted Answer · answered Jan 22 '21 at 04:20

Let's start with the basics. You hopefully started with something like this:

permutationToDisjointCycles :: [Int] -> [[Int]]
permutationToDisjointCycles perm = ...

We don't actually want to recur on the input list so much as we want to use an index counter. In this case, we'll want a recursive helper function, and the next step is to just go ahead and call it, providing whatever arguments you think you'll need. How about something like this:

permutationToDisjointCycles perm = cycles [] 0
  where
    cycles :: [Int] -> Int -> [[Int]]
    cycles seen ix = ...

Instead of declaring a pi_dict variable like in Python, we'll start with a seen list as an argument (I flipped it around to keeping track of what's been seen because that ends up being a little easier). We do the same with the counting index, which I here called ix. Let's consider the cases:

    cycles seen ix
      | ix >= length perm = -- we've reached the end of the list
      | ix `elem` seen    = -- we've already seen this index
      | otherwise         = -- we need to generate a cycle.

That last case is the interesting one and corresponds to the inner while loop of the Python code. Another while loop means, you guessed it, more recursion! Let's make up another function that we think will be useful, passing along as arguments what would have been variables in Python:

      | otherwise         = let c = makeCycle ix ix in c : cycles (c ++ seen) (ix+1)

    makeCycle :: Int -> Int -> [Int]
    makeCycle startIx currentIx = ...

Because it's recursive, we'll need a base case and recursive case (which corresponds to the if statement in the Python code which either breaks the loop or continues it). Rather than use the seen list, it's a little simpler to just check if the next element equals the starting index:

    makeCycle startIx currentIx =
      if next == start
      then -- base case
      else -- recursive call, where we attach an index onto the cycle and recur
      where next = perm !! i

I left a couple holes that need to be filled in as an exercise, and this version works on 0-indexed lists rather than 1-indexed ones like your example, but the general shape of the algorithm is there.

As a side note, the above algorithm is not super efficient. It uses lists for both the input list and the "seen" list, and lookups in lists are always O(n) time. One very simple performance improvement is to immediately convert the input list perm into an array/vector, which has constant time lookups, and then use that instead of perm !! i at the end.

The next improvement is to change the "seen" list into something more efficient. To match the idea of your Python code, you could change it to a Set (or even a HashSet), which has logarithmic time lookups (or constant with a hashset).

The code you found Math.Combinat.Permutations actually uses an array of Booleans for the "seen" list, and then uses the ST monad to do imperative-like mutation on that array. This is probably even faster than using Set or HashSet, but as you yourself could tell, readability of the code suffers a bit.

Permutation to disjoint cycles in Haskell

1 Answers1