Generowanie permutacji – algorytm Steinhaus-Johnson-Trotter

Odpowiedz Nowy wątek
2019-08-08 07:26
3

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.
edytowany 3x, ostatnio: furious programming, 2019-08-08 14:50

Pozostało 580 znaków

2019-08-08 14:37
2

Dawno dawno temu machnąłem artykuł o podobnej tematyce – Generator słów (metoda znaczników). Opisuje on klasę służącą do generowania permutacji na podstawie zadanego zbioru znaków oraz przedziału długości ciągów wyjściowych. Co prawda obecna jego forma generuje od razu wszystkie możliwe permutacje, ale nic nie stoi na przeszkodzie, aby generował tylko jedną na każde wywołanie odpowiedniej metody – w końcu stan generatora jest przechowywany w polach jego klasy.


Wracjąc do Twojego kodu – jeśli działa prawidłowo to super. Mimo wszystko sam kod jest… brzydki. :/

Przede wszystkim powinien być napisany w całości po agielsku i zgodnie z przyjętą konwencją nazewnictwa, która u Ciebie leży i kwiczy. W dodatku używasz znaków diakrytyzowanych w identyfikatorach, przez co tego kodu nie da się skompilować np. w Lazarusie… Ale pomijając już język, nie powinieneś logiki generatora rozsiewać po globalnych funkcjach, a opakować ją w jakąś konkretną strukturę, najlepiej klasę (choć od biedy zaawansowany rekord nie byłby zły).

Główna funkcja też kuleje – wiele zmiennych o nic nie mówiących nazwach (typu wart2), marnujesz mnóstwo miejsca w pionie bezsensownie grupując w bloki pojedyncze instrukcje (a ten then w nowej linii to już przesada totalna), zmienna kolejnaPermutacja nie jest w ogóle potrzebna (możesz zapisywać wynik od razu w Result).

Inna sprawa że typ kierunek mógłby w ogóle nie istnieć, bo spokojnie możesz go wymienić na Boolean. Dzięki temu zamiast pisać takie krowiaste drabinki do odwracania kierunków:

if kierunki[i]=lewy
then
  kierunki[i]:=prawy
else
  if kierunki[i]=prawy
  then
    kierunki[i]:=lewy

wystarczyło by skorzystać z negacji wartości logicznej:

Kierunki[i] := not Kierunki[i];

Zresztą Twoja drabinka i tak jest nadmiarowa, bo jeśli pierwszy warunek jest nieprawdziwy to drugi siłą rzeczy zawsze będzie prawdziwy – w końcu typ wyliczeniowy ma tylko dwie wartości.

Ale pomijając już zmianę typu, kierunek będący liczbą też można odwrócić za pomocą jednej operacji – trza go dupnąć xorem. W dodatku enumy trzeba rzutować na liczby, bo operator ten zapewne nie jest przeładowany. Czyli całą tę drabinkę możn skrócić do tej postaci:

Kierunki[i] := Kierunek(Byte(Kierunki[i]) xor Byte(Prawy));

Wygląda na przydługie, ale sprowadza się do jednej operacji logicznej, więc będzie szybsze niż zestaw warunków i przypisań. Mimo wszystko znacznie lepiej jest skorzystać w tym przypadku z typu logicznego i wykorzystać operator negacji.


Ogólnie sporo jest do poprawienia. Praktycznie wszystko wymaga zmiany/ulepszenia. ;)


edytowany 6x, ostatnio: furious programming, 2019-08-08 14:48

Pozostało 580 znaków

2019-08-08 14:50
1

Kodu ci nie sprawdzę, natomiast mogę podpowiedzieć, że algorytm generowania permutacji przez minimalną liczbę transpozycji Johnsonna-Trottera jest opisany w książce "Kombinatoryka dla programistów" Witolda Lipskiego. Pseudokod ze starego skanu:

Johnson-Trotter.png

Po szczegóły i wyjaśnienia odsyłam do wyżej wymienionej pozycji.

edytowany 1x, ostatnio: Spearhead, 2019-08-08 14:52

Pozostało 580 znaków

Odpowiedz
Liczba odpowiedzi na stronę

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0