Best shuffle: Difference between revisions

m
→‎{{header|REXX}}: re-aligned DO-loops indentation. -- ~~~~
m (→‎{{header|REXX}}: re-aligned DO-loops indentation. -- ~~~~)
Line 2,232:
 
=={{header|REXX}}==
<lang rexx>/*REXX program to find the best shuffle (offor a character string). */
list='tree abracadabra seesaw elk grrrrrr up a'
L=0 /*find width of the longest word (prettify output).*/
L=0; do ki=1 for words(list); L=max(L,length(word(list,ki))); end; L=L+5 /*i*/
L=L+5
 
do jn=1 for words(list) /*process the words in the list. */
$=word(list,jn) /*the original word in the list. */
new=bestShuffle($) new=bestShuffle($) /*shufflized version of the word.*/
say 'original:' left($,L) 'new:' left(new,L) 'count:' countSamekSame($,new)
end
exit
/*─────────────────────────────────────bestShuffle procedure────────────*/
bestShuffle: procedure; parse arg x 1 ox; Lx=length(x)
if Lx<3 then return reverse(x) /*fast track these puppies. */
 
do j=1 for Lx-1 /*first take care of replications*/
a=substr(x,j ,1)
b=substr(x,j+1,1); if a\==b then iterate
if a\==b then iterate
_=verify(x,a); if _==0 then iterate /*switch 1st rep with some char. */
y=substr(x,_,1); x=overlay(a,x,_); x=overlay(y,x,j)
x=overlay(y,x,j)
rx=reverse(x); _=verify(rx,a); if _==0 then iterate /*¬ enuf unique*/
y=substr(rx,_,1); _=lastpos(y,x) /*switch 2nd rep with later char.*/
x=overlay(a,x,_); x=overlay(y,x,j+1) /*OVERLAYs: a fast way to swap*/
end /*j*/
 
do j=1 for Lx /*take care of same o'-same o's. */
a=substr(x, j,1)
b=substr(ox,j,1)
if a\==b then iterate
if j==Lx then x=left(x,j-2)a||substr(x,j-1,1) /*spec case of last*/
else x=left(x,j-1)substr(x,j+1,1)a || substr(x,j+2)
end
 
do j=1 for Lx do k=1 for Lx /*take care of same o'-same o's. */
a=substr(x, jk,1)
b=substr(ox,k,1); if a\==b then iterate
if jk==Lx then x=left(x,jk-2)a || substr(x,jk-1,1) /*speclast case of last*/
else x=left(x,jk-1)substr(x,jk+1,1)a || substr(x,jk+2)
end /*k*/
return x
/*─────────────────────────────────────kSame procedure──────────────────*/
/*─────────────────────────────────────countSame procedure──────────────*/
countSamekSame: procedure; parse arg x,y; k=0
do jm=1 for min(length(x),length(y))
k = k + (substr(x,jm,1) == substr(y,jm,1))
end /*m*/
return k</lang>
'''output''' (with a freebie thrown in):