This is a classic programming problem for which I have not previously seen a direct recursive solution. A derangement of a list is a permutation in which no element stays in the same position. For example, the possible derangements of a few short lists are:
ghci> derangements   ghci> derangements [1..2] [[2,1]] ghci> derangements [1..3] [[3,1,2],[2,3,1]] ghci> derangements [1..4] [[2,1,4,3],[4,1,2,3],[3,1,4,2],[3,4,1,2],[4,3,1,2],[2,4,1,3],[4,3,2,1],[3,4,2,1],[2,3,4,1]]
It is known that the number of derangements of a list of length n is given by the formula below for d(n):
> d 1 = 0 > d 2 = 1 > d n = (n-1) * (d(n-1) + d(n-2))
Here are a few values for d(n):
ghci> d 1 0 ghci> d 2 1 ghci> d 3 2 ghci> d 4 9 ghci> d 5 44 ghci> d 6 265
There are several fairly straightforward solutions to the problem of producing all possible derangements of a list that involve more than one pass. For example, one can generate all permutations and then filter the ones that satisfy the additional constraint, or one can write some kind of backtracking search. These solutions are unsatisfactory in some sense as they do not convey deep properties of the problem. Specifically, it should straightforward from the solution to see that the number of solutions is d(n).
Below I develop a solution starting from the derivation of the recursion formula d(n) above. See http://math.illinoisstate.edu/day/courses/old/305/contentderangements.html for example. Mimicking the analysis in the link, we isolate the following operation as a critical piece of the solution:
> moveXtoK :: a -> [a] -> Int -> [[a]] > moveXtoK x xs k = > let (ys,(z:zs)) = splitAt (k-1) xs > in map (\ds -> z : insert x (k-1) ds) > (derangements (ys ++ zs)) ++ > map (\ (d : ds) -> d : insert x (k-1) ds) > (derangements (z : (ys ++ zs))) > > insert x 0 ys = x : ys > insert x n (y : ys) = y : insert x (n-1) ys
We are given a list with a first element x and a tail xs and a position k which points somewhere in the list xs and we want to produce a derangment in which x goes to position k. There are two cases to consider for the item that used to be at position k: either it goes to where x used to be (i.e., in the first position) or it goes somewhere else. In the first case, we produce all possible derangements for the list excluding x and the item at position k and then insert them into their final positions. In the second case, we make the recursive call on a list in which the item at position k has moved to the first position; this guarantees that it will not be in the first position in the output derangement. We then insert x into its final position.
The above helper uses a fixed position k. Clearly to get all possible derangements, we let k take every possible value. Done.
> derangements :: [a] -> [[a]] > derangements [ _ ] =  > derangements [x,y] = [ [y,x] ] > derangements (x:xs) = concatMap (moveXtoK x xs) [1..length xs]
It should be evident that this solution produces a list of length d(n).