Permutations by swapping: Difference between revisions

→‎{{header|REXX}}: added the REXX language. -- ~~~~
(→‎{{header|REXX}}: added the REXX language. -- ~~~~)
Line 964:
1, 0, 3, 2 (1)
1, 0, 2, 3 (-1)
</pre>
 
=={{header|REXX}}==
<lang rexx>/*REXX pgm generates all permutations of N different objects by swapping*/
parse arg things bunch inbetweenChars names /*get optional C.L. args*/
if things=='' | things==',' then things=4 /*use the default? */
if bunch =='' | bunch ==',' then bunch =things /* " " " */
/* ┌────────────────────────────────────────────────────────────────┐
│ things (optional) defaults to 4. │
│ bunch (optional) defaults to THINGS. │
│ inbetweenChars (optional) defaults to a [null]. │
│ names (optional) defaults to digits (and letters). │
└────────────────────────────────────────────────────────────────┘ */
call permSets things, bunch, inbetweenChars, names
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────! {factorial} subroutine────────────*/
!: procedure; parse arg x; !=1; do j=2 to x; !=!*j; end; return !
/*──────────────────────────────────P subroutine (Pick one)─────────────*/
p: return word(arg(1),1)
/*──────────────────────────────────PERMSETS subroutine─────────────────*/
permSets: procedure; parse arg x,y,between,uSyms /*X things Y at a time.*/
@.=; sep=; z=; !.=0 /*X can't be > length(@0abcs). */
@abc = 'abcdefghijklmnopqrstuvwxyz'; parse upper var @abc @abcU
@abcS= @abcU || @abc; @0abcS=123456789 || @abcS
 
do i=1 for x /*build a list of (perm) symbols.*/
_=p(word(uSyms,i) p(substr(@0abcS,i,1) k)) /*get or gen a symbol.*/
if length(_)\==1 then sep='_' /*if not 1st char, then use sep. */
z=z || sep || _ /*append it to the symbol list. */
end /*i*/
#=1
if between=='' then between=sep /*use the appropriate separator. */
!.z=1; times=!(x)%!(x-y); q=z; s=1; w=max(length(z),length('permute'))
say center('permutations for ' x ' with ' y "at a time",60,'═')
say
say 'permutation' center("permute",w,'─') 'sign'
say '───────────' center("───────",w,'─') '────'
say center(#,11) center(z,w) right(s,4)
 
do step=1 until #==times
perm=; do j=1 for x; perm=perm||sep||j; end
do k=1 for x-1
do m=k+1 to x /*method doesn't use adjaceny. */
?=
do n=1 for x /*build a new permutation by swap*/
if n\==k & n\==m then ?=? || substr(z,n,1)
else if n==k then ?=? || substr(z,m,1)
else ?=? || substr(z,k,1)
end /*n*/
z=? /*save this permute for next swap*/
if !.? then iterate m /*if defined before, try next one*/
#=#+1; s=-s; say center(#,11) center(?,w) right(s,4)
!.?=1
iterate step
end /*m*/
end /*k*/
end /*step*/
 
return</lang>
'''output''' when using the input of: <tt> 4 </tt>
<pre>
════════════permutations for 4 with 4 at a time════════════
 
permutation permute sign
─────────── ─────── ────
1 1234 1
2 2134 -1
3 3214 1
4 2314 -1
5 4231 1
6 2431 -1
7 3241 1
8 2341 -1
9 1324 1
10 3124 -1
11 4312 1
12 3412 -1
13 1342 1
14 3142 -1
15 2413 1
16 4213 -1
17 1423 1
18 4123 -1
19 4321 1
20 3421 -1
21 1432 1
22 4132 -1
23 2143 1
24 1243 -1
</pre>