53 lines
1.5 KiB
Text
53 lines
1.5 KiB
Text
shuffle: procedure options (main); /* 14/1/2011 */
|
|
declare (s, saves) character (20) varying, c character (1);
|
|
declare t(length(s)) bit (1);
|
|
declare (i, k, moves initial (0)) fixed binary;
|
|
|
|
get edit (s) (L);
|
|
put skip list (s);
|
|
saves = s;
|
|
t = '0'b;
|
|
do i = 1 to length (s);
|
|
if t(i) then iterate; /* This character has already been moved. */
|
|
c = substr(s, i, 1);
|
|
k = search (s, c, i+1);
|
|
if k > 0 then
|
|
do;
|
|
substr(s, i, 1) = substr(s, k, 1);
|
|
substr(s, k, 1) = c;
|
|
t(k), t(i) = '1'b;
|
|
end;
|
|
end;
|
|
|
|
do k = length(s) to 2 by -1;
|
|
if ^t(k) then /* this character wasn't moved. */
|
|
all: do;
|
|
c = substr(s, k, 1);
|
|
do i = k-1 to 1 by -1;
|
|
if c ^= substr(s, i, 1) then
|
|
if substr(saves, i, 1) ^= c then
|
|
do;
|
|
substr(s, k, 1) = substr(s, i, 1);
|
|
substr(s, i, 1) = c;
|
|
t(k) = '1'b;
|
|
leave all;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
moves = length(s) - sum(t);
|
|
put skip edit (s, trim(moves))(a, x(1));
|
|
|
|
search: procedure (s, c, k) returns (fixed binary);
|
|
declare s character (*) varying;
|
|
declare c character (1);
|
|
declare k fixed binary;
|
|
declare i fixed binary;
|
|
|
|
do i = k to length(s);
|
|
if ^t(i) then if c ^= substr(s, i, 1) then return (i);
|
|
end;
|
|
return (0); /* No eligible character. */
|
|
end search;
|
|
|
|
end shuffle;
|