Best shuffle: Difference between revisions

Content added Content deleted
No edit summary
(→‎{{header|REXX}}: elided a function, changed the bestShuffle function, added/changed whitespace and comments.)
Line 2,660: Line 2,660:


=={{header|REXX}}==
=={{header|REXX}}==
<lang rexx>/*REXX program determins and displays the best shuffle (for any list of words (letters)*/
<lang rexx>/*REXX program determines and displays the best shuffle for any list of words/characters*/
parse arg @ /*get some words from the command line.*/
parse arg $ /*get some words from the command line.*/
if @='' then @ = 'tree abracadabra seesaw elk grrrrrr up a' /*use the defaults? */
if $='' then $= 'tree abracadabra seesaw elk grrrrrr up a' /*use the defaults?*/
w=0 /*width of the longest word; for output*/
w=0; #=words($) /* [↑] finds the widest word in $ list*/
do i=1 for words(@) /* [↓] process all the words in list. */
do i=1 for #; @.i=word($,i); w=max(w, length(@.i) ); end /*i*/
w=max(w, length(word(@, i))) /*set the maximum word width (so far). */
end /*i*/ /* [↑] ··· finds the widest word in @.*/
w=w+9 /*add 9 blanks for output indentation. */
w=w+9 /*add 9 blanks for output indentation. */
do n=1 for words(@) /*process all the words in the @ list. */
do n=1 for #; new=bestShuffle(@.n) /*process the examples in the @ array. */
$=word(@,n) /*get the original word in the @ list. */
same=0; do m=1 for length(@.n)
new=bestShuffle($) /*get a shufflized version of the word.*/
same=same + (substr(@.n, m, 1) == substr(new, m, 1) )
say 'original:' left($,w) 'new:' left(new,w) 'count:' kSame($,new)
end /*m*/
say 'original:' left(@.n, w) 'new:' left(new,w) 'count:' same
end /*n*/
end /*n*/
exit /*stick a fork in it, we're all done. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
bestShuffle: procedure; parse arg x 1 ox; Lx=length(x)
bestShuffle: procedure; parse arg x 1 ox; L=length(x); if L<3 then return reverse(x)
if Lx<3 then return reverse(x) /*fast track small strings*/
/*[↑] fast track short strs*/
do j=1 for L-1; parse var x =(j) a +1 b +1 /*get A,B at Jth & J+1 pos.*/
if a\==b then iterate /*ignore any replicates. */
c=verify(x,a); if c==0 then iterate /* " " " */
x=overlay( substr(x,c,1), overlay(a,x,c), j) /*swap the x,c characters*/
rx=reverse(x) /*obtain the reverse of X. */
y=substr(rx, verify(rx,a), 1) /*get 2nd replicated char. */
x=overlay(y, overlay(a,x, lastpos(y,x)),j+1) /*fast swap of 2 characters*/
end /*j*/


do j=1 for Lx-1; jp=j+1 /* [↓] handle replicates.*/
do k=1 for L /*handle a possible rep. */
a=substr(x,j ,1)
a= substr( x, k, 1) /*obtain single character. */
b=substr(x,j+1,1); if a\==b then iterate /*ignore any replicates. */
b= substr(ox, k, 1) /*obtain the original char.*/
_=verify(x,a) ; if _==0 then iterate /* " " " */
if a\==b then iterate /*skip non-replications. */
y=substr(x,_,1); x=overlay(a,x,_) /*switch (swap) two ··· */
if k==L then x=left(x, k-2)a || substr(x, k-1, 1) /*last case.*/
x=overlay(y,x,j) /* ··· (x,y) characters.*/
else x=left(x, k-1)substr(x, k+1, 1)a || substr(x, k+2)
rx=reverse(x); _=verify(rx,a) /*check back end for reps.*/
if _==0 then iterate /*not enough uniqueness. */
y=substr(rx,_,1); _=lastpos(y,x) /*switch 2nd rep with char*/
x=overlay(a,x,_); x=overlay(y,x,jp) /*fast way to swap chars. */
end /*j*/

do k=1 for Lx /*handle a possible rep. */
a= substr( x, k, 1) /*obtain single character.*/
b= substr(ox, k, 1) /*obtain the original char*/
if a\==b then iterate /*skip non-replications. */
if k==Lx then x=left(x, k-2)a || substr(x, k-1, 1) /*last case.*/
else x=left(x, k-1)substr(x, k+1, 1)a || substr(x, k+2)
end /*k*/
end /*k*/
return x
return x</lang>
/*──────────────────────────────────────────────────────────────────────────────────────*/
kSame: procedure; parse arg x,y; k=0; Lx=length(x); Ly=length(y)
do m=1 for min(Lx, Ly); k=k+(substr(x, m, 1) == substr(y, m, 1))
end /*m*/
return k</lang>
'''output''' &nbsp; (with a freebie thrown in):
'''output''' &nbsp; (with a freebie thrown in):
<pre>
<pre>