To powinno być opublikowane raczej jako artykuł, ale nie wiem gdzie to się wysyła. Jako że niewiele jest stron z kodem algorytmu, podaję go do wykorzystania. Podobno on jest siedem razy szybszy od innych algorytmów. Wersja generuje kolejną permutację a nie wszystkie od razu. Dzięki temu nie muszę przetwarzania danych z permutacji dawać do środka algorytmu permutacji i dlatego taki program jest dużo czytelniejszy. Algorytm napisałem na podstawie opisu
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
kierunek=(lewy, prawy);
kierunkiPermutacji= array of kierunek;
znakiPermutacji = record
permutacja: string;
kierunki: kierunkiPermutacji;
koniecPermutacji: boolean
end;
function nextPermute(ciąg: znakiPermutacji): znakiPermutacji;
//generuje kolejny ciąg permutacji składających się z cyfr
//algorytm Steinhaus-Johnson-Trotter
var
kolejnaPermutacja: znakiPermutacji;
długośćCiągu, i, wart1, wart2, poz1, poz2, maks: integer;
bufor: string;
buforKier: kierunek;
begin
kolejnaPermutacja:= ciąg;
długośćCiągu:= length(kolejnaPermutacja.permutacja);
kolejnaPermutacja.koniecPermutacji:= true;
maks:=-1;//permutacja to zbiór cyfr, więc "maks" dajemy na mniejszy od wszystkich
with kolejnaPermutacja do
begin
for i := 1 to długośćCiągu-1 do
begin
wart1:=StrToInt(permutacja[i]); wart2:=StrToInt(permutacja[i+1]);
if (wart1>maks) and (wart1>wart2) and (kierunki[i]=prawy)
then
begin
koniecPermutacji:= false; maks:= wart1; poz1:= i; poz2:= i+1;
end;
if (wart2>maks) and (wart1<wart2) and (kierunki[i+1]=lewy)
then
begin
koniecPermutacji:= false; maks:= wart2; poz1:= i; poz2:= i+1;
end;
end;
if not koniecPermutacji
then
begin
bufor:= permutacja[poz1]; permutacja[poz1]:= permutacja[poz2]; permutacja[poz2]:= bufor[1];
buforKier:= kierunki[poz1]; kierunki[poz1]:= kierunki[poz2]; kierunki[poz2]:= buforKier;
for i := 1 to długośćCiągu do
if StrToInt(permutacja[i])>maks
then
if kierunki[i]=lewy
then
kierunki[i]:=prawy
else
if kierunki[i]=prawy
then
kierunki[i]:=lewy
end;
end;
result:= kolejnaPermutacja
end;
function szukanaPermutacja(ciąg: string): boolean;
begin
// zaślepka, tutaj się sprawdza, czy permutacja spełnia wymagania zadania
result:= true
end;
procedure wypiszWynik(perm: znakiPermutacji);
begin
//zaślepka, tutaj wynik jest odpowiednio formatowany zgodnie z warunkiami zadania
form1.memo1.Lines.Add(perm.permutacja);
end;
procedure TForm1.Button1Click(Sender: TObject);
const
znakiPocz='1234';
var
długośćZnaków: integer;
następnaPermut: znakiPermutacji;
i: integer;
begin
if szukanaPermutacja(znakiPocz)
then
memo1.Lines.Add(znakiPocz);
//inicjacja zmniennych
długośćZnaków:= length(znakiPocz);
następnaPermut.permutacja:= znakiPocz;
SetLength(następnaPermut.kierunki, długośćZnaków+1);
for i := 1 to długośćZnaków do
następnaPermut.kierunki[i]:= lewy;
//generowanie kolejnej permutacji
repeat
następnaPermut:= nextPermute(następnaPermut);
if not następnaPermut.koniecPermutacji then
begin
if szukanaPermutacja(następnaPermut.permutacja)
then
wypiszWynik(następnaPermut)
end;
until następnaPermut.koniecPermutacji;
end;
end.
Delphi 
