Rosetta Code

Permutations by swapping: Difference between revisions

Page Discussion

Permutations by swapping (view source)

Revision as of 19:21, 9 June 2018

490 bytes removed ,  6 years ago
m
→‎{{header|REXX}}: add/changed statejents, comments, whitespace, used a template for the output section.
(Scala contribution added.)
m (→‎{{header|REXX}}: add/changed statejents, comments, whitespace, used a template for the output section.)
Line 2,522:
 
=={{header|REXX}}==
<lang rexx>/*REXX program generates all permutations of N different objects by swapping. */
parse arg things bunch . /*getobtain optional arguments from the C.L. CL*/
thingsif things=='' | p(things=="," 4) then things=4 /*Not specified? /*shouldThen use the default for THINGS ? .*/
if bunch =='' | p(bunch things)=="," then bunch =things /* " " /* " " " " " BUNCH ? */
call permSets things, bunch /*invoke permutations by swapping sub. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!: procedure; !=1; do j=2 to arg(1); !=!*j; end /*j*/ end; return !
c: return substr(arg(1), arg(2), 1) /*pick a single character from a string*/
p: return word(arg(1), 1) /*pick 1st word (or number) from a list*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
permSets: procedure; parse arg x,y /*take X things Y at a time. */
!.=0; pad=left('', x*y) /*Note: X can't be > length of below str (@0abcs62). */
z=left('123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ', x); q=z
@abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU /*build symbols*/
@abcS= @abcU || @abc; @0abcS=123456789 || @abcS /* ··· and more*/
z= /*define Z to be a null value for start*/
do i=1 for x /*build list of (permutation) symbols. */
z=z || c(@0abcS, i) /*append the char to the symbol list. */
end /*i*/▼
#=1 /*the number of permutations (so far).*/
!.z=1; q=z; s=1; times=!(x) % !(x-y) /*calculate (#) TIMES using factorial.*/
w=max(length(z), length('permute')) ) /*maximum width of Z and also PERMUTE.*/
say center('permutations for ' x ' things taken ' y " at a time",60,'═')
say
say pad 'permutation' center("permute", w, '─') "sign"
say pad '───────────' center("───────", w, '─') "────"
say pad center(#, 11) center(z , w) right(s, 4-1)
 
do $=1 until #==times /*perform permutation until # of times.*/
do k=1 for x-1 /*step thru things for things-1 times.*/
do m=k+1 to x; ?= /*this method doesn't use adjacency. */
do n=1 for x /*build the new permutation by swapping*/
if n\==k & n\==m then ? = ? || csubstr(z, n, 1)
else if n==k then ? = ? || csubstr(z, m, 1)
else ? = ? || csubstr(z, k, 1)
end /*n*/
z=? /*save this permutation for next swap. */
if !.? then iterate m /*if defined before, then try next one.*/
_=0 /* [↓] count number of swapped symbols*/
do d=1 for x while $\==1; _= _ + (csubstr(?,d,1)\==csubstr(prev,d,1)); end /*d*/
if _>2 end then do; _=z/*d*/
if _>2 then do; a_=$//x+1; q=q+_ /* [← ↓] this swapping tries adjacency*/z
ba=q$//x+1; if bq==aq + then_ b=a+1;/* [← ↓] if b>xthis swapping thentries b=a-1adjacency*/
zb=overlay(c(z,q//x+1; if b),==a overlay(c(z,then b=a), + _,1; if b),>x then b=a) - 1
z=overlay( iteratesubstr(z,b,1), $overlay( substr(z,a,1), _, /*nowb), try this particular permutation.*/a)
iterate end$ /*now, try this particular permutation.*/
#=#+1; s=-s; say pad center(#,11) center(?,w) right(s,4-1)end
!.?#=#+1; prevs=? -s; say pad iterate $center(#, /*now11) center(?, tryw) another swapped permutation.*/ right(s, 4-1)
!.?=1; end prev=?; iterate $ /*mnow, try another swapped permutation.*/
end /*km*/
end /*$k*/
▲ end end /*i$*/
return /*we're all finished with permutating. */</lang>
'''{{out|output''' |text=&nbsp; when using the default inputsinput:}}
<pre>
══════permutations for 4 things taken 4 at a time═══════
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/217723"