Reset of compound combinations in delphi



  • There's a code that crosses all possible combinations of row elements and takes them to List.Box:

    procedure TForm1.Button1Click(Sender: TObject);
    var
     m: integer;
    

    procedure GenStr(S0, S1: string);
    var
    i: integer;
    begin
    if Length(S0) = m then
    ListBox1.Items.Add(S0)
    else
    for i := 1 to Length(S1) do
    GenStr(S0+S1[i], copy(S1,1,i-1) + copy(S1,i+1,Length(S1)));
    end;

    begin
    m := 3;
    GenStr('','123');
    end;

    end.

    After completed, the result is: 123132213231312321which, with regard to my task, is correct.

    But my job is to find such combinations in the elements of the body, not in the row. That is, for example, compliance:

    a[0]:=1;
    a[1]:=2;
    a[2]:=3;

    GenStr('',a[0],a[1],a[2]);

    That would give me the same result.
    How can that be realized?



  • Algorithm converts:

    1. Moving from the penultimate part of the reset looking for a[i], meeting the inequality a[i] bu a[i + 1].
    2. Modify element a[i] with the smallest element that:
      • is right a[i].
      • is larger than a[i]
    3. All elements behind a[i] shall be sorted.

    I didn't change your code. I wrote mine.

    unit Unit1;
    

    {$mode objfpc}{$H+}

    interface

    uses
    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

    type

    { TForm1 }

    TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    private
    { private declarations }
    public
    { public declarations }
    end;

    type
    ResultArray = array of integer;

    var
    Form1: TForm1;

    implementation

    {$R *.lfm}

    { TForm1 }

    procedure PrintArray(pArr: ResultArray; p: integer);
    var
    i: integer;
    s: string;
    begin
    s := '(' + IntToStr(p) + ') ';
    for i := 0 to Length(pArr) - 1 do
    s := s + IntToStr(pArr[i]);
    Form1.ListBox1.Items.Add(s);
    end;

    function SortArray(pArr: ResultArray; index: integer): ResultArray;
    var
    list: TStringList;
    i: integer;
    begin
    list := TStringList.Create;

    list.Sorted := True;

    for i := index + 1 to Length(pArr) - 1 do
    list.Add(IntToStr(pArr[i]));

    for i := 0 to list.Count - 1 do
    pArr[index + 1 + i] := StrToInt(list[i]);

    list.Free;

    result := pArr;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    var
    count: integer;
    arr: ResultArray;
    i: integer;
    xi, xj: integer;
    max, tmp: integer;
    flag: boolean;
    p: integer;
    begin
    ListBox1.Clear;

    count := StrToInt(Edit1.Text);
    SetLength(arr, count);

    p := 1;

    // Заполняем массив от 1 до count
    for i := 1 to count do
    arr[i - 1] := i;

    PrintArray(arr, p);

    Inc(p);

    while (True) do
    begin
    flag := False;
    xj := count - 1;

      // (1) Двигаясь с предпоследнего элемента перестановки, ищем элемент a[i], удовлетворяющий неравенству a[i] < a[i + 1]
      for i := xj - 1 downto 0 do
        begin
          if (arr[i] < arr[i + 1]) then
             begin
               xi := i;
               max := arr[i + 1];
               xj := i + 1;
               flag := True;
               break;
             end;
        end;
    
      if (not flag) then
         break;
    
      // (2) Меняем местами элемент a[i] с наименьшим элементом, который:
      //     а) находится праве a[i].
      //     б) является больше чем a[i].
      for i := xj to count - 1 do
        begin
          if (arr[xi] < arr[i]) and (arr[i] < max) then
             begin
               xj := i;
               max := arr[i];
             end;
        end;
    
       tmp := arr[xi];
       arr[xi] := arr[xj];
       arr[xj] := tmp;
    
       // (3) Все элементы стоящие за a[i] сортируем
       arr := SortArray(arr, xi);
    
       PrintArray(arr, p);
       Inc(p);
     end;
    

    end;
    end.

    Result:

    введите сюда описание изображения




Suggested Topics

  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2