# 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
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]);
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
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] &lt; a[i + 1]
for i := xj - 1 downto 0 do
begin
if (arr[i] &lt; 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] &lt; arr[i]) and (arr[i] &lt; 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:

2

2

2

2

2

2

2

2

2

2

2

2

2

2

2