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 |
<lang rexx>/*REXX program determines and displays the best shuffle for any list of words/characters*/ |
||
parse arg |
parse arg $ /*get some words from the command line.*/ |
||
if |
if $='' then $= 'tree abracadabra seesaw elk grrrrrr up a' /*use the defaults?*/ |
||
w=0 |
w=0; #=words($) /* [↑] finds the widest word in $ list*/ |
||
do i=1 for |
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). */ |
|||
⚫ | |||
w=w+9 /*add 9 blanks for output indentation. */ |
w=w+9 /*add 9 blanks for output indentation. */ |
||
do n=1 for |
do n=1 for #; new=bestShuffle(@.n) /*process the examples in the @ array. */ |
||
same=0; do m=1 for length(@.n) |
|||
same=same + (substr(@.n, m, 1) == substr(new, m, 1) ) |
|||
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; |
bestShuffle: procedure; parse arg x 1 ox; L=length(x); if L<3 then return reverse(x) |
||
/*[↑] 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.*/ |
|||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
x=overlay(y, overlay(a,x, lastpos(y,x)),j+1) /*fast swap of 2 characters*/ |
|||
⚫ | |||
do |
do k=1 for L /*handle a possible rep. */ |
||
a=substr(x, |
a= substr( x, k, 1) /*obtain single character. */ |
||
b=substr( |
b= substr(ox, k, 1) /*obtain the original char.*/ |
||
if a\==b then iterate /*skip non-replications. */ |
|||
if k==L 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) |
|||
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*/ |
|||
⚫ | |||
⚫ | |||
⚫ | |||
a= substr( x, k, 1) /*obtain single character.*/ |
|||
⚫ | |||
⚫ | |||
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''' (with a freebie thrown in): |
'''output''' (with a freebie thrown in): |
||
<pre> |
<pre> |