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

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


Optional stretch goal

   Calculate    !20 


Related tasks

   Anagrams/Deranged anagrams
   Best shuffle
   Left_factorials



Other tasks related to string operations:

Metrics
 Array length
 String length
 Copy a string
 Empty string  (assignment)
Counting
 Word frequency
 Letter frequency
 Jewels and stones
 I before E except after C
 Bioinformatics/base count
 Count occurrences of a substring
 Count how many vowels and consonants occur in a string
Remove/replace
 XXXX redacted
 Conjugate a Latin verb
 Remove vowels from a string
 String interpolation (included)
 Strip block comments
 Strip comments from a string
 Strip a set of characters from a string
 Strip whitespace from a string -- top and tail
 Strip control codes and extended characters from a string
Anagrams/Derangements/shuffling
 Word wheel
 ABC problem
 Sattolo cycle
 Knuth shuffle
 Ordered words
 Superpermutation minimisation
 Textonyms (using a phone text pad)
 Anagrams
 Anagrams/Deranged anagrams
 Permutations/Derangements
Find/Search/Determine
 ABC words
 Odd words
 Word ladder
 Semordnilap
 Word search
 Wordiff  (game)
 String matching
 Tea cup rim text
 Alternade words
 Changeable words
 State name puzzle
 String comparison
 Unique characters
 Unique characters in each string
 Extract file extension
 Levenshtein distance
 Palindrome detection
 Common list elements
 Longest common suffix
 Longest common prefix
 Compare a list of strings 
 Longest common substring
 Find common directory path
 Words from neighbour ones
 Change e letters to i in words
 Non-continuous subsequences
 Longest common subsequence
 Longest palindromic substrings
 Longest increasing subsequence
 Words containing "the" substring
 Sum of the digits of n is substring of n
 Determine if a string is numeric
 Determine if a string is collapsible
 Determine if a string is squeezable
 Determine if a string has all unique characters
 Determine if a string has all the same characters
 Longest substrings without repeating characters
 Find words which contains all the vowels
 Find words which contains most consonants
 Find words which contains more than 3 vowels
 Find words which first and last three letters are equals
 Find words which odd letters are consonants and even letters are vowels or vice_versa
Formatting
 Substring
 Rep-string
 Word wrap
 String case
 Align columns
 Literals/String
 Repeat a string
 Brace expansion
 Brace expansion using ranges
 Reverse a string
 Phrase reversals
 Comma quibbling
 Special characters
 String concatenation
 Substring/Top and tail
 Commatizing numbers
 Reverse words in a string
 Suffixation of decimal numbers
 Long literals, with continuations 
 Numerical and alphabetical suffixes
 Abbreviations, easy
 Abbreviations, simple
 Abbreviations, automatic
Song lyrics/poems/Mad Libs/phrases
 Mad Libs
 Magic 8-ball
 99 Bottles of Beer
 The Name Game (a song)
 The Old lady swallowed a fly
 The Twelve Days of Christmas
Tokenize
 Text between
 Tokenize a string
 Word break problem
 Tokenize a string with escaping
 Split a character string based on change of character
Sequences
 Show ASCII table
 De Bruijn sequences
 Self-referential sequences
 Generate lower case ASCII alphabet




*        Permutations/Derangements 01/04/2017
DERANGE  CSECT
         USING  DERANGE,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         XPRNT  PG1,L'PG1          print title
         LA     R1,4               4
         LA     R2,1               1 : combinations print
         BAL    R14,DERGEN         call dergen
         STH    R0,COUNT           count=dergen(4,1)
         XPRNT  PG2,L'PG2          print table headings
         XPRNT  PG3,L'PG3          print hyphens
         SR     R4,R4
         STH    R4,II              ii=0
       DO WHILE=(CH,R4,LE,=H'9')   do ii=0 to 9
         MVC    PG,=CL80' '          clear buffer
         XDECO  R4,PG                edit ii
         LR     R1,R4                ii
         LA     R2,0                 0 : no combination print
         BAL    R14,DERGEN           dergen(ii,0)
         XDECO  R0,PG+12             edit
         LH     R1,II                ii
         BAL    R14,SUBFACT          subfact(ii)
         XDECO  R0,PG+24             edit
         XPRNT  PG,L'PG              print
         LH     R4,II                ii
         LA     R4,1(R4)             i+1
         STH    R4,II                i=i+1
       ENDDO    ,                  enddo i
         LA     R0,12              12
         STH    R0,II              ii=12 
         MVC    PG,=CL16'!xx='     init buffer
         XDECO  R0,XDEC            edit ii
         MVC    PG+1(2),XDEC+10    output
         LH     R1,II              ii
         BAL    R14,SUBFACT        subfact(ii)
         XDECO  R0,PG+4            edit subfact(ii)
         XPRNT  PG,16              print
         L      R13,4(0,R13)       restore previous savearea pointer
         LM     R14,R12,12(R13)    restore previous context
         XR     R15,R15            rc=0
         BR     R14                exit
*------- ----   -------------------------------------------
DERGEN   EQU    *                  dergen(n,fprt)
         ST     R14,SAVEDG
         ST     R1,N               n
         ST     R2,FPRT            fprt
       IF LTR,R1,Z,R1 THEN         if n=0 then
         LA     R0,1                 1
         B      RETDG                return(1)
       ENDIF    ,                  endif
         MVC    C,=F'0'            c=0
         LA     R6,1               i=1
       DO WHILE=(C,R6,LE,N)        do i=1 to 2
         LR     R1,R6                i
         SLA    R1,1
         STH    R6,A-2(R1)           a(i)=i
         STH    R6,AO-2(R1)          ao(i)=i
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         L      R1,N               n
         BAL    R14,FACT
         ST     R0,FACTNM1         fact(n)-1
         SR     R6,R6              i=0
       DO WHILE=(C,R6,LE,FACTNM1)  do i=0 to fact(n)-1
         L      R1,N                 n
         BAL    R14,NEXTPER          call nextper(n)
         MVI    D,X'01'              d=true
         LA     R7,1
       DO WHILE=(C,R7,LE,N)          do j=1 to n
         LR     R1,R7                  j
         SLA    R1,1
         LH     R2,A-2(R1)             a(j)
         LH     R3,AO-2(R1)            ao(j)
       IF CR,R2,EQ,R3 THEN             if a(j)=ao(j) then
         MVI    D,X'00'                  d=false
       ENDIF    ,                      endif
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
       IF CLI,D,EQ,X'01' THEN        if d then
         L      R2,C                   c
         LA     R2,1(R2)               c+1
         ST     R2,C                   c=c+1
       IF CLI,FPRT+3,EQ,X'01' THEN     if fprt=1 then
         MVC    PG,=CL80' '              clear buffer
         LA     R10,PG                   pgi=0
         LA     R7,1                     j=1
       DO WHILE=(C,R7,LE,N)              do j=1 to n
         LR     R1,R7                      j
         SLA    R1,1
         LH     R2,A-2(R1)                 a(j)
         XDECO  R2,XDEC                    edit
         MVC    0(1,R10),XDEC+11           output
         LA     R10,2(R10)                 pgi=pgi+2
         LA     R7,1(R7)                   j++
        ENDDO    ,                        enddo j
         XPRNT  PG,L'PG                   print
       ENDIF    ,                      endif
       ENDIF    ,                    endif
         LA     R6,1(R6)             i++
        ENDDO    ,                 enddo i
         L      R0,C               c
         B      RETDG              return(c)
RETDG    L      R14,SAVEDG
         BR     R14
SAVEDG   DS     A
*------- ----   -------------------------------------------
NEXTPER  EQU    *                  nextper(nk)
         ST     R14,SAVENP
         ST     R1,NK              nk
         BCTR   R1,0               nk-1
         ST     R1,NELEM           nelem=nk-1
       IF C,R1,LT,=F'1' THEN       if nelem<1 then
         LA     R0,0                 return(0)
         B      RETNP
       ENDIF    ,                  endif
         L      R8,NELEM           nelem
         BCTR   R8,0               pos=nelem-1
LOOPW1   EQU    *                  while a(pos+1)>=a(pos+2) 
         LR     R1,R8                pos
         SLA    R1,1
         LH     R2,A(R1)             a(pos+1)
         CH     R2,A+2(R1)           if a(pos+1)<a(pos+2)
         BL     ELOOPW1              then exit while 
         BCTR   R8,0                 pos=pos-1
       IF LTR,R8,M,R8 THEN           if pos<0 then
         LA     R1,0                   0
         L      R2,NELEM               nelem
         BAL    R14,PERMREV            call permrev(0,nelem)
         LA     R0,0                   return(0)
         B      RETNP
       ENDIF    ,                    endif
         B      LOOPW1             endwhile
ELOOPW1  L      R9,NELEM           last=nelem
LOOPW2   EQU    *                  do while a(last+1)<=a(pos+1)
         LR     R1,R9                last
         SLA    R1,1
         LH     R2,A(R1)             a(last+1)
         LR     R1,R8                pos
         SLA    R1,1
         CH     R2,A(R1)             if a(last+1)>a(pos+1)
         BH     ELOOPW2              then exit while 
         BCTR   R9,0                 last=last-1
         B      LOOPW2             endwhile
ELOOPW2  LR     R1,R8              pos
         SLA    R1,1               *2
         LA     R2,A(R1)           @a(pos+1)
         LR     R1,R9              last
         SLA    R1,1
         LA     R3,A(R1)           @a(last+1)
         LH     R0,0(R2)           w=a(pos+1)
         MVC    0(2,R2),0(R3)      a(pos+1)=a(last+1)
         STH    R0,0(R3)           a(last+1)=w
         LA     R1,1(R8)           pos+1
         L      R2,NELEM           nelem
         BAL    R14,PERMREV        call permrev(pos+1,nelem)
RETNP    L      R14,SAVENP
         BR     R14
SAVENP   DS     A
*------- ----   -------------------------------------------
PERMREV  EQU    *                  permrev(firstix,lastix)
         LR     R4,R1              xfirst
         LR     R5,R2              xlast
       DO WHILE=(CR,R4,LT,R5)      do while(xfirst<xlast)
         LR     R1,R4                xfirst
         SLA    R1,1                 *2
         LA     R2,A(R1)             @a(xfirst+1)
         LR     R1,R5                xlast
         SLA    R1,1                 *2
         LA     R3,A(R1)             @a(xlast+1)
         LH     R0,0(R2)             w=a(xfirst+1)
         MVC    0(2,R2),0(R3)        a(xfirst+1)=a(xlast+1)
         STH    R0,0(R3)             a(xlast+1)=w
         LA     R4,1(R4)             xfirst=xfirst+1
         BCTR   R5,0                 xlast=xlast-1
       ENDDO    ,                  enddo
         BR     R14
*------- ----   ----------------------------------------
FACT     EQU    *                  fact(n)
       IF C,R1,LE,=F'1' THEN       if n<=1 then
         LA     R0,1                 return(1)
       ELSE     ,                  else
         LA     R5,1                 f=1
         LA     R2,1                 i=1
       DO WHILE=(CR,R2,LE,R1)        do i=1 to n
         MR     R4,R2                  f*i
         LA     R2,1(R2)               i++
       ENDDO    ,                    enddo
         LR     R0,R5                return(f)
       ENDIF    ,                  endif
         BR     R14
*------- ----   -------------------------------------------
SUBFACT  EQU    *                  subfact(n)
         ST     R1,NY              n
       IF LTR,R1,Z,R1 THEN         if n=0 then
         LA     R0,1                 return(1)
       ELSE     ,                  else
         LA     R4,1                 1
         ST     R4,TT                tt(0)=1
         ST     R4,IY                i=1
       DO WHILE=(C,R4,LE,NY)         do i=1 to n
         L      R4,IY                  i
         SRDA   R4,32
         D      R4,=F'2'               i/2
       IF LTR,R4,Z,R4 THEN             if i//2=0 then
         LA     R0,1                     nn=1
       ELSE     ,                      else
         L      R0,=F'-1'                nn=-1
       ENDIF    ,                      endif
         L      R1,IY                  i
         SLA    R1,2
         L      R3,TT-4(R1)            tt(i-1)
         M      R2,IY                  *i
         AR     R3,R0                  +nn
         L      R1,IY                  i
         SLA    R1,2
         ST     R3,TT(R1)              tt(i)=i*tt(i-1)+nn
         L      R4,IY                  i
         LA     R4,1(R4)               i++
         ST     R4,IY                  i
       ENDDO    ,                    enddo
         L      R1,NY                n
         SLA    R1,2
         L      R0,TT(R1)            return(tt(n))
       ENDIF    ,                  endif
         BR     R14
*        ----   -------------------------------------------
A        DS     12H                A work
AO       DS     12H                A origin
II       DS     H
COUNT    DS     H
N        DS     F
FPRT     DS     F                  flag for printing
C        DS     F
D        DS     X                  boolean : a(i) different ao(i)
FACTNM1  DS     F                  fact(n)-1
NK       DS     F                  n           in nextper
NELEM    DS     F                  n elements  in nextper
NY       DS     F                  n           in subfact
IY       DS     F                  i           in subfact
TT       DS     13F                tt(0:12)
PG1      DC     CL44'derangements for the numbers : 1 2 3 4 are :'
PG2      DC     CL38'  table of n     counted  calculated :'
PG3      DC     CL36' ----------- ----------- -----------'
XDEC     DS     CL12               temp for xdeco
PG       DC     CL80' '            buffer
         YREGS
         END    DERANGE