There is a code that List.Box through all possible combinations of line elements and displays them in 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 the execution I get the result: 123 , 132 , 213 , 231 , 312 , 321 , which, regarding the execution of my task, is correct.

But my task is to find such combinations in the elements of the array, and not in the string. Ie, for example execution:

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

would give me the same result. How can this be implemented?

  • Explain, please, do you need to find different combinations for each element of the array, or is the array order just different? - ivan K.
  • The different order of the elements in the array. For example, we look for the maximum number of permutations of the factorial, i.e. for 3 elements it is 3! = 6 combinations. And then all possible combinations are calculated. For example, for elements 1,2,3 these are combinations 132, 213, 231, 312,321 - Ivan Ivanov
  • It is better, perhaps, to even give such an example if the numbers are confused: Elements "a", "b", "c". Combinations: avb, bav, bva, wab, wba - Ivan Ivanov
  • @Ivanov i. instead of a string we pass an array and get an array of strings right? - ivan K.
  • one
    Possible duplicate question: All possible combinations of a one-dimensional array - slippyk

1 answer 1

The permutation algorithm is as follows:

  1. Moving from the penultimate element of the permutation, we are looking for the element a [i], which satisfies the inequality a [i] <a [i + 1].
  2. Swap the element a [i] with the smallest element that:
    • is located to the right of a [i].
    • is larger than a [i]
  3. All elements behind a [i] are sorted.

I did not redo your code. Wrote your own.

 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:

enter image description here