Best shuffle: Difference between revisions

<lang rexx>/*REXX program to findfinds the best shuffle (for aany characterlist stringof words (characters). */

parse arg list@ /*get some words from the command line.*/

if list@='' then list@ = 'tree abracadabra seesaw elk grrrrrr up a' /*def.use default? */

w=0 /*widestwidth wordof ,the forlongest prettifing.word; for output*/

do i=1 for words(list@) /* [↓] process all the words in list. */

w=max(w, length(word(list@, i))) /*set the maximum word width (so far). */

end /*i*/ /* [↑] ··· finds the widest word in @.*/

w=w+59 /*add five9 spacesblanks, tothe widestoutput wordlooks nicer.*/

do n=1 for words(list@) /*process all the words in the @ list. */

$=word(list@,n) /*get the original word in the @ list. */

new=bestShuffle($) /*get a shufflized version of the word.*/

say 'original:' left($,w) 'new:' left(new,w) 'count:' kSame($,new)

exit /*stick a fork in it, we're all done. */

/*──────────────────────────────────BESTSHUFFLE subroutine──────────────subroutine────────────────────*/

if Lx<3 then return reverse(x) /*fast track these puppies. small # of puppies. */

do j=1 for Lx-1; jp=j+1 /* [↓] handle any possible /*first take care of replicationsreplicates.*/

b=substr(x,j+1,1); if a\==b then iterate /*ignore replicates.*/

_=verify(x,a); if _==0 then iterate /*switch 1st repreplicate with some char. */

y=substr(x,_,1); x=overlay(a,x,_)

x=overlay(y,x,j)

rx=reverse(x); _=verify(rx,a); if _==0 then iterate /*¬enough enuf uniqueuniqueness*/

y=substr(rx,_,1); _=lastpos(y,x) /*switch 2nd repreplicate with later char.*/

x=overlay(a,x,_); x=overlay(y,x,j+1jp) /*OVERLAYs: a fast way to swap chars. */

do k=1 for Lx /*takehandle carecases of samepossible o'-same o'sreplicates. */

a=substr( x, k,1)

b=substr(ox,k,1); if a\==b then iterate /*skip replicate. */

if k==Lx then x=left(x,k-2)a || substr(x,k-1,1) /*handle last case*/

else x=left(x,k-1)substr(x,k+1,1)a || substr(x,k+2)

/*──────────────────────────────────KSAME procedure─────────────────────procedure───────────────────────────*/

kSame: procedure; parse arg x,y; k=0

do m=1 for min(length(x), length(y)); k=k + (substr(x,m,1) == substr(y,m,1))

'''output''' &nbsp; (with a freebie thrown in):

original: tree new: eert count: 0

original: abracadabra new: baaracadrab count: 0

original: seesaw new: eswase count: 0

original: elk new: lke count: 0

original: grrrrrr new: rrrrrrg count: 5

original: up new: pu count: 0

original: a new: a count: 1