Rosetta Code

Best shuffle: Difference between revisions

Page Discussion

Best shuffle (view source)

Revision as of 21:33, 20 June 2016

882 bytes removed ,  7 years ago
→‎{{header|REXX}}: elided a function, changed the bestShuffle function, added/changed whitespace and comments.
No edit summary
(→‎{{header|REXX}}: elided a function, changed the bestShuffle function, added/changed whitespace and comments.)
Line 2,660:
 
=={{header|REXX}}==
<lang rexx>/*REXX program determinsdetermines and displays the best shuffle (for any list of words (letters)/characters*/
parse arg @$ /*get some words from the command line.*/
if @$='' then @ $= 'tree abracadabra seesaw elk grrrrrr up a' /*use the defaults? */
w=0; #=words($) /* [↑] /*width offinds the longestwidest word; forin $ outputlist*/
do i=1 for words#; @.i=word(@$,i); w=max(w, length(@.i) ); end /* [↓] process all the words in list. 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. */
do n=1 for words#; new=bestShuffle(@.n) /*process all the wordsexamples in the @ listarray. */
$same=word(@,n)0; do m=1 for /*get the original word in the length(@ list. */n)
new=bestShuffle($) /*get a shufflized version ofsame=same the word+ (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*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
bestShuffle: procedure; parse arg x 1 ox; Lx L=length(x); if L<3 then return reverse(x)
if Lx<3 then return reverse(x) /*[↑] fast track smallshort stringsstrs*/
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 /*skipignore non-replicationsany replicates. */▼
c=verify(x,a); if do kc==10 forthen Lxiterate /* " " " /*handle a possible rep. */▼
x=overlay(a, substr(x,_c,1);, x=overlay(ya,x,jpc), j) /*fastswap waythe to swapx,c chars. characters*/▼
▲ end /*i*/ rx=reverse(x) /* [↑] ··· finds /*obtain the widestreverse wordof in @X. */
by= substr(oxrx, kverify(rx,a), 1) /*obtainget the2nd originalreplicated char. */▼
x=overlay(y, overlay(a,x, lastpos(y,x)),j+1) /*fast swap of 2 characters*/
end /*j*/▼
 
do jk=1 for Lx-1;L jp=j+1 /*handle [↓]a possible handle replicatesrep. */
a= substr( x,j k, 1) /*obtain single character. */
b= substr(xox,j+1 k, 1); if a\==b then iterate /*ignoreobtain anythe replicatesoriginal char. */
_=verify(x,a) ; if _a\==0b then iterate /* " " " /*skip non-replications. */
y=substr(x,_,1); if k==L then x=overlayleft(a,x,_ k-2)a || substr(x, k-1, 1) /*switch (swap) two ···last case.*/
else x=overlayleft(yx, k-1)substr(x,j) k+1, 1)a || /* ··· substr(x,y k+2) characters.*/
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*/
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):
<pre>
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/167044"