![]()  | 
	
 
  | 
		
			
  | 	
	
	
		
		|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны | 
| 
		 | 
	Опции темы | Поиск в этой теме | Опции просмотра | 
| 
		 
			 
			#9  
			
			
			
			
		 
		
		
	 | 
|||
		
		
  | 
|||
| 
	
	
		
			
			 Вот вроде рабочий вариант, только не забудь что число перестановок растет со скорость факторриала!!! 
		
	
		
		
		
		
		
	
		
		
	
	
	Код: 
	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; |