17
\$\begingroup\$

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.

\$\endgroup\$
  • \$\begingroup\$ Can we submit a generator? \$\endgroup\$ – Fatalize Apr 30 at 11:53
  • \$\begingroup\$ @Fatalize Yes I think this would be similar enough to the other two mentioned methods (or do you think there is a strong argument against it?). \$\endgroup\$ – flawr Apr 30 at 11:55
  • 1
    \$\begingroup\$ @Fatalize Actually it seems returning a generator instead of a list is possible by default. \$\endgroup\$ – flawr May 1 at 6:31

23 Answers 23

7
\$\begingroup\$

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]
\$\endgroup\$
5
\$\begingroup\$

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
\$\endgroup\$
5
\$\begingroup\$

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
\$\endgroup\$
4
\$\begingroup\$

Ruby, 55 bytes

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

Try it online!

Generates all 0-based derangements

\$\endgroup\$
2
\$\begingroup\$

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
\$\endgroup\$
2
\$\begingroup\$

Wolfram Language (Mathematica), 55 bytes

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

Try it online!

\$\endgroup\$
2
\$\begingroup\$

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
\$\endgroup\$
2
\$\begingroup\$

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.

\$\endgroup\$
2
\$\begingroup\$

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]
\$\endgroup\$
2
\$\begingroup\$

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!

\$\endgroup\$
2
\$\begingroup\$

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!

\$\endgroup\$
1
\$\begingroup\$

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
\$\endgroup\$
1
\$\begingroup\$

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
\$\endgroup\$
1
\$\begingroup\$

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.

\$\endgroup\$
1
\$\begingroup\$

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!

\$\endgroup\$
1
\$\begingroup\$

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!

\$\endgroup\$
  • \$\begingroup\$ You can do much better if you use an output parameter, particularly if it’s an std::array so it’s pre-sized — 145 bytes \$\endgroup\$ – Roman Odaisky May 1 at 17:06
  • \$\begingroup\$ @RomanOdaisky: nice idea, but how I understand the rules of code golf, you'll have to take the preallocation code into your byte count. \$\endgroup\$ – movatica May 1 at 18:38
  • \$\begingroup\$ @movatica A gray area, I think the code is more likely valid than invalid. It will happily write the correct results somewhere, and it’s the caller’s responsibility of reading the output. Note that STL algorithms such as std::copy likewise entrust the caller with providing adequate space for the output. \$\endgroup\$ – Roman Odaisky May 1 at 18:45
  • \$\begingroup\$ @RomanOdaisky: STL behaviour is indeed a valid argument. \$\endgroup\$ – movatica May 1 at 18:48
0
\$\begingroup\$

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!

\$\endgroup\$
0
\$\begingroup\$

Haskell, 76 bytes

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

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!

\$\endgroup\$
0
\$\begingroup\$

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 $_ {$++==$_})}}
\$\endgroup\$
  • 1
    \$\begingroup\$ Good start, you can make the filter shorter with Z on != for -7 bytes: tio.run/##K0gtyjH7n1upoJamYKvwv7ogtSi3tCSxJDM/… \$\endgroup\$ – Phil H May 2 at 12:49
  • \$\begingroup\$ @PhilH I knew there has to be a way to integrate the zip operator but I couldn't quite figure it out. Nice \$\endgroup\$ – user0721090601 May 2 at 12:50
  • \$\begingroup\$ PhilH using that strategy, can still knock another 3 by killing parentheses: tio.run/##K0gtyjH7n1upoJamYKvwv7ogtSi3tCSxJDM/… \$\endgroup\$ – user0721090601 May 2 at 13:00
  • \$\begingroup\$ PhilH that last one doesn't work. For all but n=2 more than just one element will be rejected \$\endgroup\$ – user0721090601 May 2 at 13:19
  • \$\begingroup\$ Of course, forgot the requirement... removed \$\endgroup\$ – Phil H May 2 at 13:21
0
\$\begingroup\$

Charcoal, 44 28 bytes

crossed out 44 is still regular 44

NθIΦEXθθEθ﹪÷ιXθλθ⬤ι‹⁼μλ⁼¹№ιλ

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

Nθ                              Input `n`
     Xθθ                        `n` raised to power `n`
    E                           Mapped over implicit range
         θ                      `n`
        E                       Mapped over implicit range
            ι                   Outer loop index
           ÷                    Integer divided by
             Xθ                 `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
  I                             Cast to string
                                Implicitly print
\$\endgroup\$
0
\$\begingroup\$

C (gcc), 187 180 bytes

*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!

\$\endgroup\$
  • \$\begingroup\$ @ceilingcat Thank you. \$\endgroup\$ – Jonathan Frech Sep 15 at 19:16
0
\$\begingroup\$

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.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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