Enumerate Derangements

Question

Given some positive integer \$n\$ generate all derangements of \$n\$ objects.

Details

• A derangement is a permutation with no fixed point. (This means in every derangement number \$i\$ cannot be in the \$i\$-th entry).
• The output should consist of derangements of the numbers \$(1,2,\ldots,n)\$ (or alternatively \$(0,1,2,\ldots,n-1)\$).
• You can alternatively always print derangements of \$(n,n-1,\ldots,1)\$ (or \$(n-1,n-2,\ldots,1,0)\$ respectively) but you have to specify so.
• The output has to be deterministic, that is whenever the program is called with some given \$n\$ as input, the output should be the same (which includes that the order of the derangements must remain the same), and the complete output must be done within a finite amount of time every time (it is not sufficient to do so with probability 1).
• You can assume that \$ n \geqslant 2\$
• For some given \$n\$ you can either generate all derangements or alternatively you can take another integer \$k\$ that serves as index and print the \$k\$-th derangement (in the order you chose).

Examples

Note that the order of the derangements does not have to be the same as listed here:

n=2: (2,1)
n=3: (2,3,1),(3,1,2)
n=4: (2,1,4,3),(2,3,4,1),(2,4,1,3), (3,1,4,2),(3,4,1,2),(3,4,2,1), (4,1,2,3),(4,3,1,2),(4,3,2,1)

OEIS A000166 counts the number of derangements.

Answer 1

Jelly, 6 bytes

Œ!=ÐṂR

A monadic Link accepting a positive integer which yields a list of lists of integers.

Try it online!

How?

Œ!=ÐṂR - Link: integer, n
Œ!     - all permutations of (implicit range of [1..n])
     R - range of [1..n]
   ÐṂ  - filter keep those which are minimal by:
  =    -   equals? (vectorises)
       -   ... i.e. keep only those permutations that evaluate as [0,0,0,...,0]

Answer 2

Brachylog, 9 bytes

⟦kpiᶠ≠ᵐhᵐ

Try it online!

This is a generator that outputs one derangement of [0, …, n-1] given n.

If we wrap it in a ᶠ - findall metapredicate, we get all possible generations of derangements by the generator.

Explanation

⟦           The range [0, …, Input]
 k          Remove the last element
  p         Take a permutation of the range [0, …, Input - 1]
   iᶠ       Take all pair of Element-index: [[Elem0, 0],…,[ElemN-1, N-1]]
     ≠ᵐ     Each pair must contain different values
       hᵐ   The output is the head of each pair

Answer 3

JavaScript (V8), 85 bytes

A recursive function printing all 0-based derangements.

f=(n,p=[],i,k=n)=>k--?f(n,p,i,k,k^i&&!p.includes(k)&&f(n,[...p,k],-~i)):i^n||print(p)

Try it online!

Commented

f = (                   // f is a recursive function taking:
  n,                    //   n   = input
  p = [],               //   p[] = current permutation
  i,                    //   i   = current position in the permutation
  k = n                 //   k   = next value to try
) =>                    //         (a decrementing counter initialized to n)
  k-- ?                 // decrement k; if it was not equal to 0:
    f(                  //   do a recursive call:
      n, p, i, k,       //     leave all parameters unchanged
      k ^ i &&          //     if k is not equal to the position
      !p.includes(k) && //     and k does not yet appear in p[]:
        f(              //       do another recursive call:
          n,            //         leave n unchanged
          [...p, k],    //         append k to p
          -~i           //         increment i
                        //         implicitly restart with k = n
        )               //       end of inner recursive call
    )                   //   end of outer recursive call
  :                     // else:
    i ^ n ||            //   if the derangement is complete:
      print(p)          //     print it

Answer 4

Ruby, 55 bytes

->n{[*0...n].permutation.select{|x|x.all?{|i|i!=x[i]}}}

Try it online!

Generates all 0-based derangements

Answer 5

05AB1E, 9 bytes

Lœʒāø€Ë_P

Try it online!

Explanation

L           # push [1 ... input]
 œ          # get all permutations of that list
  ʒ         # filter, keep only lists that satisfy
   āø       # elements zipped with their 1-based index
     €Ë_P   # are all not equal

Answer 6

Wolfram Language (Mathematica), 55 bytes

Select[Permutations[s=Range@#],FreeQ[Ordering@#-s,0]&]&

Try it online!

Answer 7

Japt, 8 bytes

0-based

o á fÈe¦

Try it (Footer increments all elements for easier comparison with the test cases)

o á fÈe¦     :Implicit input of integer
o            :Range [0,input)
  á          :Permutations
    f        :Filter
     È       :By passing each through this function
      e      :  Every element of the permutation
       ¦     :  Does not equal its 0-based index

Answer 8

Python 2, 102 bytes

lambda n:[p for p in permutations(range(n))if all(i-j for i,j in enumerate(p))]
from itertools import*

Try it online!

0-based indexing, list of tuples.

Non-itertools-based solution:

Python 2, 107 bytes

n=input()
for i in range(n**n):
 t=[];c=1
 for j in range(n):c*=j!=i%n not in t;t+=[i%n];i/=n
 if c:print t

Try it online!

0-based indexing, lines of lists, full program.

Note: This solution, even though it doesn't import the itertools library, isn't much longer than the other one which does import it, because most of the bulk here is building the permutations. The derangement check is really about 7 additional bytes! The reason is that the check is done on the fly as part of the building of each permutation. This isn't true for the other solution, where you have to check if each permutation returned by the itertools.permutations function is in fact a derangement, and, of course, the mapping itself takes a lot of bytes.

Answer 9

Perl 5 -MList::Util=none -n, 100 89 bytes

$"=',';@b=1..$_;map{%k=$q=0;say if none{++$q==$_||$k{$_}++}/\d+/g}glob join$",("{@b}")x@b

Try it online!

Answer 10

MATL, 11 bytes

:tY@tb-!AY)

This generates all derangements in lexicographical order.

Try it online!

Explanation with example

Consider input 3.

:     % Implicit input n. Range [1 2 ... n]
      % STACK: [1 2 3]
t     % Duplicate
      % STACK: [1 2 3], [1 2 3]
Y@    % All permutations, in lexicographical order, as rows of a matrix
      % STACK: [1 2 3], [1 2 3; 1 3 2; ··· ; 3 2 1]
t     % Duplicate
      % STACK: [1 2 3], [1 2 3; 1 3 2; ··· ; 3 2 1], [1 2 3; 1 3 2; ··· ; 3 2 1]
b     % Bubble up: moves third-topmost element in stack to the top
      % STACK: [1 2 3; 1 3 2; ··· ; 3 2 1], [1 2 3; 1 3 2; ··· ; 3 1 2; 3 2 1], [1 2 3]
-     % Subtract, element-wise with broadcast
      % STACK: [1 2 3; 1 3 2; ··· ; 3 2 1], [0 0 0; 0 1 -1; ··· ; 2 -1 -1; 2 0 -2]
!A    % True for rows containining only nonzero elements
      % STACK: [1 2 3; 1 3 2; ··· ; 3 1 2; 3 2 1], [false false ··· true false]
Y)    % Use logical mask as a row index. Implicit display
      % STACK: [2 3 1; 3 1 2]

Answer 11

Haskell, 58 bytes

f n|r<-[1..n]=[l|l<-mapM(\i->filter(/=i)r)r,all(`elem`l)r]

Try it online!

60 bytes

f n|r<-[1..n]=foldr(\i m->[x:l|l<-m,x<-r,all(/=x)$i:l])[[]]r

Try it online!

Answer 12

J, 26 bytes

i.(]#~0~:*/@(-|:))i.@!A.i.

Try it online!

i. (] #~ 0 ~: */@(- |:)) i.@! A. i.
i. (                   )            NB. 0..input
   (                   ) i.@! A. i. NB. x A. y returns the
                                    NB. x-th perm of y
                                    NB. i.@! returns 
                                    NB. 0..input!. Combined
                                    NB. it produces all perms
                                    NB. of y
    ] #~ 0 ~: */@(- |:)             NB. those 2 are passed as
                                    NB. left and right args
                                    NB. to this
    ] #~                            NB. filter the right arg ]
                                    NB. (all perms) by:
         0 ~:                       NB. where 0 is not equal to...
              */@                   NB. the product of the 
                                    NB. rows of...
                 (- |:)             NB. the left arg minus
                                    NB. the transpose of
                                    NB. the right arg, which
                                    NB. will only contain 0
                                    NB. for perms that have
                                    NB. a fixed point

Answer 13

R, 81 80 bytes

function(n)unique(Filter(function(x)all(1:n%in%x&1:n-x),combn(rep(1:n,n),n,,F)))

Try it online!

Returns a list containing all derangements. Highly inefficient, as it generates \$ n^2\choose n\$ possible values as the size-n combinations of [1..n] repeated n times, then filters for permutations 1:n%in%x and derangements, 1:n-x.

R + gtools, 62 bytes

function(n,y=gtools::permutations(n,n))y[!colSums(t(y)==1:n),]

Try it online!

Much more efficient, returns a matrix where each row is a derangement.

Answer 14

Gaia, 10 bytes

┅f⟨:ċ=†ỵ⟩⁇

Try it online!

┅		| push [1 2 ... n]
 f		| push permutations
  ⟨	⟩⁇	| filter where result of following is truthy
   :ċ		| dup, push [1 2 ... n]
     =†ỵ	| there is no fixed point

Answer 15

C++ (gcc), 207 196 bytes

-5 bytes by ceilingcat -6 bytes by Roman Odaisky

#include<regex>
#define v std::vector
auto p(int n){v<v<int>>r;v<int>m(n);int i=n;for(;m[i]=--i;);w:for(;std::next_permutation(&m[0],&m[n]);r.push_back(m))for(i=n;i--;)if(m[i]==i)goto w;return r;}

Try it online!

Answer 16

Python 3.8 (pre-release), 96 bytes

lambda n:(p for i in range(n**n)if len({*(p:=[j for k in range(n)for j in{i//n**k%n}-{k}])})==n)

Try it online!

Answer 17

Perl 6, 49 37 bytes

Edit: After some back and forth with Phil H, we've whittled it down to only 37 bytes:

(^*).permutations.grep:{all @_ Z-^@_}

Try it online!

By using the Whatever at the beginning, we can avoid the brackets (saves 2 chars). Next use a the Z metaoperator with - which takes each element of a permutation (e.g. 2,3,1) and subtracts 0,1,2 in order. If any of them are 0 (falsy) then the all junction fails.

---

Original solution was (Try it online!)

{permutations($_).grep:{none (for $_ {$++==$_})}}

Answer 18

C++ (gcc), 133 bytes

I think this has grown different enough from the other submission to merit a separate answer. Finally a use for index[array] inside-out syntax!

#include<regex>
[](int n,auto&r){int i=n;for(;i[*r]=--i;);for(;std::next_permutation(*r,*r+n);)for(i=n;i--?(r[1][i]=i[*r])-i:!++r;);}

Try it online!

Answer 19

Haskell, 76 bytes

n&x=[x++[i]|i<-[1..n],notElem i x,i/=length x+1]
d n=iterate(>>=(n&))[[]]!!n

Answer 20

Python 2, 82 bytes

f=lambda n,i=0:i/n*[[]]or[[x]+l for l in f(n,i+1)for x in range(n)if~-(x in[i]+l)]

Try it online!

88 bytes as program:

M=[],
r=range(input())
for i in r:M=[l+[x]for l in M for x in r if~-(x in[i]+l)]
print M

Try it online!

93 bytes using itertools:

from itertools import*
r=range(input())
print[p for p in permutations(r)if all(map(cmp,p,r))]

Try it online!

Answer 21

Charcoal, 44 28 bytes

crossed out 44 is still regular 44

ＮθＩΦＥＸθθＥθ﹪÷ιＸθλθ⬤ι‹⁼μλ⁼¹№ιλ

Try it online! Link is to verbose version of code. Loosely based on @EricTheOutgolfer's non-itertools answer. Explanation:

Ｎθ                              Input `n`
     Ｘθθ                        `n` raised to power `n`
    Ｅ                           Mapped over implicit range
         θ                      `n`
        Ｅ                       Mapped over implicit range
            ι                   Outer loop index
           ÷                    Integer divided by
             Ｘθ                 `n` raised to power
               λ                Inner loop index
          ﹪     θ               Modulo `n`
   Φ                            Filtered where
                  ι             Current base conversion result
                 ⬤              All digits satisfy
                         №ιλ    Count of that digit
                       ⁼¹       Equals literal 1
                   ‹            And not
                    ⁼μλ         Digit equals its position
  Ｉ                             Cast to string
                                Implicitly print

Answer 22

C (gcc), 187 180 bytes

• Saved seven bytes thanks to ceilingcat.

*D,E;r(a,n,g,e){e=g=0;if(!a--){for(;e|=D[g]==g,g<E;g++)for(n=g;n--;)e|=D[n]==D[g];for(g*=e;g<E;)printf("%d ",D[g++]);e||puts("");}for(;g<E;r(a))D[a]=g++;}y(_){int M[E=_];D=M;r(_);}

Try it online!

Answer 23

Pyth, 12 bytes

f*F.e-bkT.PU

Try it online!

           UQ # [implicit Q=input] range(0,Q)
         .P  Q# [implicit Q=input] all permutations of length Q
f             # filter that on lambda T:
   .e   T     #   enumerated map over T: lambda b (=element), k (=index):
     -bk      #     b-k
 *F           # multiply all together

The filter works like this: if any element is at its original spot, (element-index) will be 0 and the whole product will be 0, and thus falsey.