1

Есть код, который перебирает все возможные комбинации элементов строки и выводит их в 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.

После выполнения получаю результат: 123, 132, 213, 231, 312, 321, который, касательно выполнения моей задачи, является верным.

Но моя задача состоит в том,чтобы найти такие комбинации в элементах массива, а не в строке. Т.е., например выполнение:

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

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

дало бы мне такой же результат. Как это можно реализовать?

7
  • Поясни пожалуйста, тебе нужно для каждого элемента массива найти различные комбинации или просто порядок массива различный?
    – ivan K.
    9 июн 2016 в 8:32
  • Различный порядок элементов в массиве. Ищется, например, максимальное число перестановок факториалом, т.е. для 3-х элеменотов это 3!=6 комбинаций. А потом уже вычисляются все возможные комбинации. Например, для элементов 1,2,3 это комбинации 132, 213, 231, 312,321 9 июн 2016 в 8:45
  • Лучше, наверное, даже такой пример привести, если числа путают: Элементы "а","б","в". Комбинации: авб, бав,бва,ваб,вба 9 июн 2016 в 8:51
  • @Ivanov т.е. мы вместо строки передаем массив и получаем массив строк верно?
    – ivan K.
    9 июн 2016 в 8:55
  • 1
    Возможный дубликат вопроса: Все возможные комбинации одномерного массива
    – slippyk
    20 июн 2016 в 13:42

2 ответа 2

3

Алгоритм перестановок следующий:

  1. Двигаясь с предпоследнего элемента перестановки, ищем элемент a[i], удовлетворяющий неравенству a[i] < a[i + 1].
  2. Меняем местами элемент a[i] с наименьшим элементом, который:
    • находится правее a[i].
    • является большим чем a[i]
  3. Все элементы стоящие за a[i] сортируем.

Не стал переделывать ваш код. Написал свой.

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.

Результат:

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

0

Код на С#:

Метод генерирует все возможные комбинации символов из переданной строки val:

    public static List<string> GetAllCombinations(string val)
    {
        var currComb = new List<string>();
        if (string.IsNullOrEmpty(val))
        {
            return currComb;
        }

        currComb.Add(val[0].ToString());
        if (val.Length == 1)
        {
            return currComb;
        }

        var prevComb = new List<string>();
        for (int i = 1; i < val.Length; i++)
        {
            prevComb.Clear();
            prevComb.AddRange(currComb);
            currComb.Clear();
            for (int c = 0; c < prevComb.Count; c++) // Все предыдущие комбинации
            {
                for (int p = 0; p <= prevComb[c].Length; p++) // Все возможные вставки для текущей комбинации
                {
                    currComb.Add(BuildCombination(val[i], p, prevComb[c]));
                }
            }
        }

        return currComb;
    }

Вспомогательный метод, который формирует одну комбинацию:

    private static string BuildCombination(char ch, int insertPosition, string val)
    {
        var str = new StringBuilder(val.Length + 1);
        for (int i = 0; i < val.Length; i++)
        {
            if (i == insertPosition)
            {
                str.Append(ch);
            }
            str.Append(val[i]);
        }
        if (insertPosition == val.Length)
        {
            str.Append(ch);
        }
        return str.ToString();
    }
1

Ваш ответ

Нажимая на кнопку «Отправить ответ», вы соглашаетесь с нашими условиями использования и подтверждаете, что прочитали и поняли наши политику конфиденциальности и нормы поведения.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.