How to resolve the algorithm Permutations/Derangements step by step in the 360 Assembly programming language
Published on 12 May 2024 09:40 PM
How to resolve the algorithm Permutations/Derangements step by step in the 360 Assembly programming language
Table of Contents
Problem Statement
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.
Let's start with the solution:
Step by Step solution about How to resolve the algorithm Permutations/Derangements step by step in the 360 Assembly programming language
Source code in the 360 programming language
* 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)
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
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
You may also check:How to resolve the algorithm Dynamic variable names step by step in the Forth programming language
You may also check:How to resolve the algorithm Count in octal step by step in the XPL0 programming language
You may also check:How to resolve the algorithm Make directory path step by step in the OCaml programming language
You may also check:How to resolve the algorithm Loops/For step by step in the Plain English programming language
You may also check:How to resolve the algorithm Hello world/Standard error step by step in the Euphoria programming language