Permutations/Derangements: Difference between revisions

From Rosetta Code
Content added Content deleted
(adding gap)
(→‎{{header|GAP}}: Marked incomplete. Parts 3 & 4 missing.)
Line 257: Line 257:


=={{header|GAP}}==
=={{header|GAP}}==
{{incomplete|GAP|Parts 3 & 4 missing.}}
<lang gap>#All of this is built-in
<lang gap>#All of this is built-in
Derangements([1 .. 4]);
Derangements([1 .. 4]);

Revision as of 21:34, 12 June 2011

Task
Permutations/Derangements
You are encouraged to solve this task according to the task description, using any language you may know.

A derangement is a permutation of the order of distinct items in which no item appears in its original place.

For example, the only two derangements of the three items (0, 1, 2) are (1, 2, 0), and (2, 0, 1).

The number of derangements of n distinct items is known as the subfactorial of n, sometimes written as !n. There are various ways to calculate !n.

Task

The task is to:

  1. Create a named function/method/subroutine/... to generate derangements of the integers 0..n-1, (or 1..n if you prefer).
  2. Generate and show all the derangements of 4 integers using the above routine.
  3. Create a function that calculates the subfactorial of n, !n.
  4. Print and show a table of the counted number of derangements of n vs. the calculated !n for n from 0..9 inclusive.

As an optional stretch goal:

  • Calculate !20.
Cf.

BBC BASIC

Works with: BBC BASIC for Windows

<lang BBC BASIC> 

     PRINT"Derangements for the numbers 0,1,2,3 are:"
     Count% = FN_Derangement_Generate(4,TRUE)
     
     PRINT'"Table of n, counted derangements, calculated derangements :"
     
     FOR I% = 0 TO 9
       PRINT I%, FN_Derangement_Generate(I%,FALSE), FN_SubFactorial(I%)
     NEXT
     
     PRINT'"There is no long int in BBC BASIC!"
     PRINT"!20 = ";FN_SubFactorial(20)
     
     END
     
     DEF FN_Derangement_Generate(N%, fPrintOut)
     LOCAL A%(), O%(), C%, D%, I%, J%
     IF N% = 0 THEN = 1
     DIM A%(N%-1), O%(N%-1)
     FOR I% = 0 TO N%-1 : A%(I%) = I% : NEXT
     O%() = A%()
     FOR I% = 0 TO FN_Factorial(DIM(A%(),1)+1)-1
       PROC_NextPermutation(A%())
       D% = TRUE
       FOR J%=0 TO N%-1
         IF A%(J%) = O%(J%) THEN D% = FALSE
       NEXT
       IF D% THEN
         C% += 1
         IF fPrintOut THEN
           FOR K% = 0 TO N%-1
             PRINT ;A%(K%);" ";
           NEXT
           PRINT
         ENDIF
       ENDIF
     NEXT
     = C%
     
     DEF PROC_NextPermutation(A%())
     LOCAL first, last, elementcount, pos
     elementcount = DIM(A%(),1)
     IF elementcount < 1 THEN ENDPROC
     pos = elementcount-1
     WHILE A%(pos) >= A%(pos+1)
       pos -= 1
       IF pos < 0 THEN
         PROC_Permutation_Reverse(A%(), 0, elementcount)
         ENDPROC
       ENDIF
     ENDWHILE
     last = elementcount
     WHILE A%(last) <= A%(pos)
       last -= 1
     ENDWHILE
     SWAP A%(pos), A%(last)
     PROC_Permutation_Reverse(A%(), pos+1, elementcount)
     ENDPROC
     
     DEF PROC_Permutation_Reverse(A%(), firstindex, lastindex)
     LOCAL first, last
     first = firstindex
     last = lastindex
     WHILE first < last
       SWAP A%(first), A%(last)
       first += 1
       last -= 1
     ENDWHILE
     ENDPROC
     
     DEF FN_Factorial(N) : IF (N = 1) OR (N = 0) THEN =1 ELSE = N * FN_Factorial(N-1)
     
     DEF FN_SubFactorial(N) : IF N=0 THEN =1 ELSE =N*FN_SubFactorial(N-1)+-1^N
     
     REM Or you could use:
     REM DEF FN_SubFactorial(N) : IF N<1 THEN =1 ELSE =(N-1)*(FN_SubFactorial(N-1)+FN_SubFactorial(N-2))

</lang>

The program outputs the following : <lang> Derangements for the numbers 0,1,2,3 are: 1 0 3 2 1 2 3 0 1 3 0 2 2 0 3 1 2 3 0 1 2 3 1 0 3 0 1 2 3 2 0 1 3 2 1 0

Table of n, counted derangements, calculated derangements : 

        0         1         1
        1         0         0
        2         1         1
        3         2         2
        4         9         9
        5        44        44
        6       265       265
        7      1854      1854
        8     14833     14833
        9    133496    133496

There is no long int in BBC BASIC! !20 = 8.95014632E17 > </lang>

D

Works with: D version 2

<lang d>import std.stdio, std.algorithm, std.typecons, std.array, std.conv, std.range;

auto derangements(size_t n, bool countonly = 0) { 

   auto seq = array(iota(n));
   auto ori = seq.dup;
   auto tot = fact(n);

   size_t[][] all;
   size_t cnt = n == 0;

   while (--tot > 0) {
       size_t j = n - 2;
       while (seq[j] > seq[j + 1]) {
           j--;
       }
       size_t k = n - 1;
       while (seq[j] > seq[k]) {
           k--;
       }   
       swap(seq[k], seq[j]);
   
       size_t r = n - 1;
       size_t s = j + 1;
       while (r > s) {
           swap(seq[s], seq[r]);
           r--;
           s++;
       }

       j = 0;
       while (j < n && seq[j] != ori[j]) {
           j++;
       }
       if (j == n) {
           if (countonly) {
               cnt++;
           } else {
               all ~= seq.dup;
           }
       }
   }
   return tuple(all, cnt);

}

pure T fact(T)(T n) { 

   T result = 1;
   for (T i = 2; i <= n; i++) {
       result *= i;
   }
   return result;

}

pure T subfact(T)(T n) { 

   if (0 <= n && n <= 2) {
       return n != 1;
   }
   return (n - 1) * (subfact(n - 1) + subfact(n - 2));

}

void main() { 

   writeln("derangements for n = 4\n");
   foreach (d; derangements(4)[0]) {
       writeln(d);
   }

   writeln("\ntable of n vs counted vs calculated derangements\n");
   foreach (i; 0 .. 10) {
       writefln("%s  %-7s%-7s", i, derangements(i, 1)[1], subfact(i));
   }

   writefln("\n!20 = %s", subfact(20L));

}</lang>

Output: 

derangements for n = 4

[1, 0, 3, 2]
[1, 2, 3, 0]
[1, 3, 0, 2]
[2, 0, 3, 1]
[2, 3, 0, 1]
[2, 3, 1, 0]
[3, 0, 1, 2]
[3, 2, 0, 1]
[3, 2, 1, 0]

table of n vs counted vs calculated derangements

0  1      1
1  0      0
2  1      1
3  2      2
4  9      9
5  44     44
6  265    265
7  1854   1854
8  14833  14833
9  133496 133496

!20 = 895014631192902121

Slightly slower but more compact recursive version of the derangements function, based on the D entry of the permutations task.

<lang d>auto derangementsR(size_t n, bool countonly = 0) { 

   auto seq = array(iota(n));
   auto ori = seq.dup;
   size_t[][] res;
   size_t cnt;

   void perms(size_t[] s, size_t[] pre = []) {
       if (s.length) {
           foreach (i, c; s) {
              perms(s[0 .. i] ~ s[i + 1 .. $], pre ~ c);
           }
       } else if (mismatch!q{a != b}(pre, ori)[0].length == 0){
           if (countonly) cnt++;
           else res ~= pre;
       }
   }

   perms(seq);
   return tuple(res, cnt);

}</lang>

GAP

This example is incomplete. Parts 3 & 4 missing. Please ensure that it meets all task requirements and remove this message.

<lang gap>#All of this is built-in Derangements([1 .. 4]);

  1. [ [ 2, 1, 4, 3 ], [ 2, 3, 4, 1 ], [ 2, 4, 1, 3 ], [ 3, 1, 4, 2 ], [ 3, 4, 1, 2 ], [ 3, 4, 2, 1 ],
  2. [ 4, 1, 2, 3 ], [ 4, 3, 1, 2 ], [ 4, 3, 2, 1 ] ]

Size(last);

  1. 9

NrDerangements([1 .. 4]);

  1. 9</lang>

J

Note: !n in J denotes factorial (or gamma n+1), and not subfactorial.

<lang j>derangement=: (A.&i.~ !)~ (*/ .~: # [) i. NB. task item 1 subfactorial=: ! * +/@(_1&^ % !)@i.@>: NB. task item 3</lang>

Requested examples:

<lang j> derangement 4 NB. task item 2 1 0 3 2 1 2 3 0 1 3 0 2 2 0 3 1 2 3 0 1 2 3 1 0 3 0 1 2 3 2 0 1 3 2 1 0 

  (,subfactorial,#@derangement)"0 i.10  NB. task item 4

0 1 1 1 0 0 2 1 1 3 2 2 4 9 9 5 44 44 6 265 265 7 1854 1854 8 14833 14833 9 133496 133496 

  subfactorial 20 NB. stretch task

8.95015e17 

  subfactorial 20x NB. using extended precision

895014631192902121</lang>

Note that derangement 10 was painfully slow (almost 3 seconds, about 10 times slower than derangement 9 and 100 times slower than derangement 8) -- this is a brute force approach. But brute force is an appropriate solution here, since factorial divided by subfactorial asymptotically approaches a value near 0.367879 (the reciprocal of e).

Java

Translation of: D

<lang java>import java.util.ArrayList; import java.util.Arrays; import java.util.List;

public class Derangement { 

   public static void main(String[] args) {
       System.out.println("derangements for n = 4\n");
       for (Object d  : (ArrayList)(derangements(4, false)[0])) {
           System.out.println(Arrays.toString((int[])d));
       }
       
       System.out.println("\ntable of n vs counted vs calculated derangements\n");
       for (int i = 0; i < 10; i++) {
           int d = ((Integer)derangements(i, true)[1]).intValue();
           System.out.printf("%d  %-7d %-7d\n", i, d, subfact(i));
       }
       
       System.out.printf ("\n!20 = %20d\n", subfact(20L));
   }

   static Object[] derangements(int n, boolean countOnly) {
       int[] seq = iota(n);
       int[] ori = Arrays.copyOf(seq, n);
       long tot = fact(n);

       List<int[]> all = new ArrayList<int[]>();
       int cnt = n == 0 ? 1 : 0;

       while (--tot > 0) {
           int j = n - 2;
           while (seq[j] > seq[j + 1]) {
               j--;
           }
           int k = n - 1;
           while (seq[j] > seq[k]) {
               k--;
           }
           swap(seq, k, j);

           int r = n - 1;
           int s = j + 1;
           while (r > s) {
               swap(seq, s, r);
               r--;
               s++;
           }

           j = 0;
           while (j < n && seq[j] != ori[j]) {
               j++;
           }
           if (j == n) {
               if (countOnly) {
                   cnt++;
               } else {
                   all.add(Arrays.copyOf(seq, n));
               }
           }
       }
       return new Object[]{all, cnt};
   }

   static long fact(long n) {
       long result = 1;
       for (long i = 2; i <= n; i++) {
           result *= i;
       }
       return result;
   }

   static long subfact(long n) {
       if (0 <= n && n <= 2) {
           return n != 1 ? 1 : 0;
       }
       return (n - 1) * (subfact(n - 1) + subfact(n - 2));
   }

   static void swap(int[] arr, int lhs, int rhs) {
       int tmp = arr[lhs];
       arr[lhs] = arr[rhs];
       arr[rhs] = tmp;
   }

   static int[] iota(int n) {
       if (n < 0) {
           throw new IllegalArgumentException("iota cannot accept < 0");
       }
       int[] r = new int[n];
       for (int i = 0; i < n; i++) {
           r[i] = i;
       }
       return r;
   }

}</lang> 

derangements for n = 4

[1, 0, 3, 2]
[1, 2, 3, 0]
[1, 3, 0, 2]
[2, 0, 3, 1]
[2, 3, 0, 1]
[2, 3, 1, 0]
[3, 0, 1, 2]
[3, 2, 0, 1]
[3, 2, 1, 0]

table of n vs counted vs calculated derangements

0  1       1      
1  0       0      
2  1       1      
3  2       2      
4  9       9      
5  44      44     
6  265     265    
7  1854    1854   
8  14833   14833  
9  133496  133496 

!20 =   895014631192902121

PARI/GP

<lang parigp>derangements(n)=if(n,round(n!/exp(1)),1); derange(n)={ my(v=[[]],tmp); for(level=1,n, tmp=List(); for(i=1,#v, for(k=1,n, if(k==level, next); for(j=1,level-1,if(v[i][j]==k, next(2))); listput(tmp, concat(v[i],k)) ) ); v=Vec(tmp) ); v }; derange(4) for(n=0,9,print("!"n" = "#derange(n)" = "derangements(n))) derangements(20)</lang> Output: 

%1 = [[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]]

!0 = 1 = 1
!1 = 0 = 0
!2 = 1 = 1
!3 = 2 = 2
!4 = 9 = 9
!5 = 44 = 44
!6 = 265 = 265
!7 = 1854 = 1854
!8 = 14833 = 14833
!9 = 133496 = 133496

%2 = 895014631192902121

Perl

<lang Perl>sub d { 

       # compare this with the deranged() sub to see how to turn procedural
       # code into functional one ('functional' as not in 'understandable')
       $#_ ? map d([ @{$_[0]}, $_[$_] ], @_[1 .. $_-1, $_+1 .. $#_ ]),
                       grep { $_[$_] != @{$_[0]} } 1 .. $#_
           : $_[0]

}

sub deranged { # same as sub d above, just a readable version to explain method 

       my ($result, @avail) = @_;
       return $result if !@avail;              # no more elements to pick from, done

       my @list;                               # list of permutations to return
       for my $i (0 .. $#avail) {              # try to add each element to result in turn
               next if $avail[$i] == @$result; # element n at n-th position, no-no
               my $e = splice @avail, $i, 1;   # move the n-th element from available to result
               push @list, deranged([ @$result, $e ], @avail);
                                               # and recurse down, keep what's returned
               splice @avail, $i, 0, $e;       # put that element back, try next
       }
       return @list;

}

sub choose { # choose k among n, i.e. n! / k! (n-k)! 

       my ($n, $k) = @_;
       factorial($n) / factorial($k) / factorial($n - $k)

}

my @fact = (1); sub factorial { 

       # //= : standard caching technique.  If cached value available,
       #       return it; else compute, cache and return.
       #       For this specific task not really necessary.
       $fact[ $_[0] ] //= $_[0] * factorial($_[0] - 1)

}

my @subfact; sub sub_factorial { 

       my $n = shift;
       $subfact[$n] //= do     # same caching stuff, try comment out this line
       {
               # computes deranged without formula, using recursion
               my $total = factorial($n);      # total permutations
               for my $k (1 .. $n) {
                       # minus the permutations where k items are fixed
                       # to original location, and the rest deranged
                       $total -= choose($n, $k) * sub_factorial($n - $k)
               }
               $total
       }

}

print "Derangements for 3 elements:\n"; my @deranged = d([], 0 .. 3); for (1 .. @deranged) { 

       print "$_: @{$deranged[$_-1]}\n"

}

print "\nCompare list length and calculated table\n"; for (0 .. 9) { 

       my @x = d([], 0 .. $_-1);
       print $_, "\t", scalar(@x), "\t", sub_factorial($_), "\n"

}

print "\nNumber of derangements:\n"; print "$_:\t", sub_factorial($_), "\n" for 1 .. 20;</lang>

Output:

Derangements for 3 elements:
1: 1 0 3 2
2: 1 2 3 0
3: 1 3 0 2
4: 2 0 3 1
5: 2 3 0 1
6: 2 3 1 0
7: 3 0 1 2
8: 3 2 0 1
9: 3 2 1 0

Compare list length and calculated table
0       1       1
1       0       0
2       1       1
3       2       2
4       9       9
5       44      44
6       265     265
7       1854    1854
8       14833   14833
9       133496  133496

Number of derangements:
1:      0
2:      1
3:      2
4:      9
5:      44
6:      265
7:      1854
8:      14833
9:      133496
10:     1334961
11:     14684570
12:     176214841
13:     2290792932
14:     32071101049
15:     481066515734
16:     7697064251745
17:     130850092279664
18:     2355301661033953
19:     44750731559645106
20:     895014631192902121

PicoLisp

<lang PicoLisp>(load "@lib/simul.l") # For 'permute'

(de derangements (Lst) 

  (filter
     '((L) (not (find = L Lst)))
     (permute Lst) ) )

(de subfact (N) 

  (if (>= 2 N)
     (if (= 1 N) 0 1)
     (*
        (dec N)
        (+ (subfact (dec N)) (subfact (- N 2))) ) ) )</lang>

Output: 

: (derangements (range 1 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))

: (for I (range 0 9)
   (tab (2 8 8)
      I
      (length (derangements (range 1 I)))
      (subfact I) ) )
 0       1       1
 1       0       0
 2       1       1
 3       2       2
 4       9       9
 5      44      44
 6     265     265
 7    1854    1854
 8   14833   14833
 9  133496  133496
-> NIL

: (subfact 20)
-> 895014631192902121

Python

Includes stretch goal. <lang python>from itertools import permutations import math


def derangements(n): 

   'All deranged permutations of the integers 0..n-1 inclusive'
   return ( perm for perm in permutations(range(n))
            if all(indx != p for indx, p in enumerate(perm)) )

def subfact(n): 

   if n == 2 or n == 0:
       return 1
   elif n == 1:
       return 0
   elif  1 <= n <=18:
       return round(math.factorial(n) / math.e)
   elif n.imag == 0 and n.real == int(n.real) and n > 0:
       return (n-1) * ( subfact(n - 1) + subfact(n - 2) )
   else:
       raise ValueError()

def _iterlen(iter): 

   'length of an iterator without taking much memory'
   l = 0
   for x in iter:
       l += 1
   return l

if __name__ == '__main__': 

   n = 4
   print("Derangements of %s" % (tuple(range(n)),))
   for d in derangements(n):
       print("  %s" % (d,))

   print("\nTable of n vs counted vs calculated derangements")
   for n in range(10):
       print("%2i %-5i %-5i" %
             (n, _iterlen(derangements(n)), subfact(n)))

   n = 20
   print("\n!%i = %i" % (n, subfact(n)))</lang>
Sample output
Derangements of (0, 1, 2, 3)
  (1, 0, 3, 2)
  (1, 2, 3, 0)
  (1, 3, 0, 2)
  (2, 0, 3, 1)
  (2, 3, 0, 1)
  (2, 3, 1, 0)
  (3, 0, 1, 2)
  (3, 2, 0, 1)
  (3, 2, 1, 0)

Table of n vs counted vs calculated derangements
 0 1     1    
 1 0     0    
 2 1     1    
 3 2     2    
 4 9     9    
 5 44    44   
 6 265   265  
 7 1854  1854 
 8 14833 14833
 9 133496 133496

!20 = 895014631192902121

Tcl

Library: Tcllib (Package: struct::list)

<lang tcl>package require Tcl 8.5; # for arbitrary-precision integers package require struct::list; # for permutation enumerator

proc derangements lst { 

   # Special case
   if {![llength $lst]} {return {{}}}
   set result {}
   for {set perm [struct::list firstperm $lst]} {[llength $perm]} \

{set perm [struct::list nextperm $perm]} { set skip 0 foreach a $lst b $perm { if {[set skip [string equal $a $b]]} break } if {!$skip} {lappend result $perm} 

   }
   return $result

}

proc deranged1to n { 

   for {set i 1;set r {}} {$i <= $n} {incr i} {lappend r $i}
   return [derangements $r]

}

proc countDeranged1to n { 

   llength [deranged1to $n]

}

proc subfact n { 

   if {$n == 0} {return 1}
   if {$n == 1} {return 0}
   set o 1
   set s 0
   for {set i 1} {$i < $n} {incr i} {

set s [expr {$i * ($o + [set o $s])}] 

   }
   return $s

}</lang> Demonstrating with the display parts of the task: <lang tcl>foreach d [deranged1to 4] { 

   puts "derangement of 1..4: $d"

}

puts "\n\tcounted\tcalculated" for {set i 0} {$i <= 9} {incr i} { 

   puts "!$i\t[countDeranged1to $i]\t[subfact $i]"

}

  1. Stretch goal

puts "\n!20 = [subfact 20]"</lang> Output: 

derangement of 1..4: 2 1 4 3
derangement of 1..4: 2 3 4 1
derangement of 1..4: 2 4 1 3
derangement of 1..4: 3 1 4 2
derangement of 1..4: 3 4 1 2
derangement of 1..4: 3 4 2 1
derangement of 1..4: 4 1 2 3
derangement of 1..4: 4 3 1 2
derangement of 1..4: 4 3 2 1

	counted	calculated
!0	1	1
!1	0	0
!2	1	1
!3	2	2
!4	9	9
!5	44	44
!6	265	265
!7	1854	1854
!8	14833	14833
!9	133496	133496

!20 = 895014631192902121
Retrieved from "https://rosettacode.org/wiki/Permutations/Derangements?oldid=180627"