Показать сообщение отдельно
  #9  
Старый 11.08.2008, 14:27
Drozh Drozh вне форума
Активный
 
Регистрация: 12.06.2008
Сообщения: 313
Репутация: 40
По умолчанию )))

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

Код:
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;
Ответить с цитированием