[Кодер]

Помогите пожалуйста..

Есть слово например это переменная S. Нужно чтобы в Memo добавлялся возможный вариант.

Например: слово ABC

В Memo:

ACB
BAC
BCA
CAB
CBA

[Кодер]

Никто не знает?..

[shaman]

посмотри, может поможет

http://www.delphisources.ru/forum/showthread.php?t=2927

[Кодер]

Чтото не катит, я не то имел ввиду.. в примере БД создается со словарём а мне просто нужно найти все варинты при переб оре

[Drozh]

А чесло букв определено или слова разной длины?

[Кодер]

Пользователь должен ввести слово в TEdit например. Но колличество букв не проблема

Код:

Length(Edit1.Text);

[Zander_driver]

Вобще-то проблема...
Поидее алгоритм такой - сначала перебираем все возможные варианты как подставить первую букву комбинации. Потом меняем следующую букву и опять перебираем первую. Потом опять и т.д. пока не переберем все буквы столько раз сколько возможно вариантов подстановки каждой буквы.
Т.е. циклов будет столько сколько букв. Я попробовал такой код написать - что то у меня неполучилось. не из-за вложенных циклов, просто не получается алгоритм организовать.

[shaman]

Всё таки у меня получилось решить твою задачу. Вот код:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  SBase, SDict: string; 

  procedure BruteForce(S: string; n: integer); 
  var
   i: integer;
  begin
   for i := 1 to Length(SDict) do
   begin
     s[n] := SDict[i];
     if n = 1 then
       Memo1.Lines.Add(s)
     else
       BruteForce(s, n - 1);
   end;
  end;

begin
  SBase := edit1.Text;    // длина генерируемых слов
  SDict := edit1.Text;  // символы из которых будем генерировать
  BruteForce(SBase, Length(SBase));
end;

end.

Admin: Информация по тегам тут. Настоятельно советую изучить, дабы не нарушать правила форума, которых следует придерживаться всем и каждому.

P.S. Админ, извини, у меня теги не получается вставить

[Drozh]

Вот вроде рабочий вариант, только не забудь что число перестановок растет со скорость факторриала!!!

Код:

type
 TIntVec = array of Integer;

procedure AllPermutations(n: Integer; var a: TIntVec; S: String);
var
 i: Integer;
 Nums: TIntVec;
//------------------------------------
  function ExistsInNums(Num: Integer): boolean;
  var
   j: Integer;
  begin
   Result := false;
    for j := 1 to n do
     if Nums[j] = Num then
     begin
      Result:= true;
      exit;
     end;
  end;

  procedure WorkWithPerm;
  var
   i: Integer;
   Res: String;
  begin
   SetLength(Res, Length(S));

    for i := 1 to n do
      Res[i] := S[a[Nums[i]]];
   Form1.Memo1.Lines.Add(Res);
  end;

  procedure ResurseForPerm(j, i: Integer);
  var
   k: Integer;
  begin
   Nums[j] := i;
    if j = n then
     WorkWithPerm
    else
     for k := 1 to n do
      if not ExistsInNums(k) then
       ResurseForPerm(j+1, k);
   Nums[j] := 0;
  end;
// ---------------------------------------
begin
 SetLength(Nums, n+1);
  for i := 1 to n do
   ResurseForPerm(1, i);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
 n, i: Integer;
 a: TIntVec;
 S: String;
begin
 Memo1.Clear;

 S := Edit1.Text;
 n := Length(S);
 SetLength(a, n+1);
  for i := 1 to N do
   a[i]:= i;

 AllPermutations(n, a, S);

 label1.Caption := IntToStr(Memo1.Lines.Count);
end;

Еще, для трех символов можно использовать:

Код:

var
C1, C2: Char;
i, j: Integer;
Source: String;
begin

Source := Edit1.Text;

 for i := 1 to Len do
 begin
  for j := 1 to Length(Source) do
  begin
   C1 := Source[j];
   C2 := Source[j +1];
 
   Source[j] := C2;
   Source[j + 1] := C1;

   Memo1.Lines.Add(Source);
  end;
 end;
end;

а для четырехсимвольного:

Код:

var
C1, C2: Char;
i, j: Integer;
Source: String;
begin

Source := Edit1.Text;

 for i := 1 to Length(Source) do
 begin
  for j := 1 to Length(Source)-1 do
  begin
   C1 := Source[j];
   C2 := Source[j +1];
 
   Source[j] := C2;
   Source[j + 1] := C1;

   Memo1.Lines.Add(Source);
  end;
 end;

  for i := 1 to Length(Source) do
  begin
   for j := Length(Source) downto 2 do
   begin
    C1 := Source[j];
    C2 := Source[j - 1];

    Source[j] := C2;
    Source[j - 1] := C1;

    Memo1.Lines.Add(Source);
   end;
  end;
end;