Перебор

← →
Сергей Макаров (2002-12-11 18:50) [0]

Добрый вечер. даны цифры 123456, как получить все возможные перестоновки этого числа. т.е. 132456,234561 и т.д.
благодарствую.

← →
Igorek © (2002-12-11 19:10) [1]

Делаешь глобальный масив на 6 цифр.
Потом рекурсивную процедуру, которая вызывается до глубины 6. Имеет индекс глубины, вставляет в ячейку соотв. глубине все цифры по порядку, которые еще не использованы в предыдущих ячейках. После этого вызывает сама себя. Когда нельзя вставить число, или глубина зашкаливает - возвращается.

Сорри, что на словах - лень код писать. Может разберешься. ;-)

← →
VictorT © (2002-12-11 21:09) [2]

Сам писал недавно такую для друга, любящего разгадывать журнальные головоломки с призами, правда она дома у меня, если хочешь, принесу на роботу и вышлю... Если быть точным, она переставляет не обязательно цифры, можно и буквы (в общем любые знаки). Ещё бы учесть, что могут быть одинаковые цифры в слове, ато она ,например, для 11 выдаеёт два варианта перестановки - 11 и 11... Просто алгоритм сам выгонял, а если по правильному, то надо бы вспомнить теорию вероятности, раздел комбинаторика...

← →
Uncle Archi © (2002-12-11 21:50) [3]

Вот моё решение подобной задачи с олипиады(вывести n перестановок с k-той)

Type
ar=array[1..26]of Integer;

Const
AC:String=("ABCDEFGHIJKLMNOPQRSTUVWXYZ");

Var
n:Byte;
a:ar;
Inp,Out:Text;
k,d,i,j:Longint;
s:String;

Procedure CloseF;
Begin
Close(inp);
Close(Out);
Halt;
End;

Function Sr1:Boolean;
var
ii,jj:Byte;
Begin
For ii:=1 to n do
For jj:=ii+1 to n do
If a[ii]=a[jj] then Begin Sr1:=False; Exit; End;
Sr1:=True;
End;

Function Sr(aa:Ar):Boolean;
Var
ii,jj:Byte;
Begin
Sr:=False;
jj:=n+1;
For ii:=1 to n do
Begin
Dec(jj);
if aa[ii]<>aa[jj] then Exit;
End;
Sr:=True;
End;

Function Per(aa:Ar):String;
Var
Result:String;
ii:Byte;
Begin
Result:="";
For ii:=1 to n do
Result:=Result+AC[aa[ii]];
Per:=Result;
End;

Procedure Gen(var aa:ar);
Var
ii:Integer;
Begin
For ii:=n downto 1 do
if aa[ii]<n then
begin
Inc(aa[ii]);
Break;
end
else aa[ii]:=1;
End;

Begin
{ CheckBreak:=False;}
Assign(Inp,"Input.txt");
Reset(Inp);
Assign(Out,"Output.txt");
Rewrite(Out);
Readln(Inp,n,k,d);
For i:=1 to n do
a[i]:=i;
s:=Per(a);
j:=0;
i:=0;
Repeat
Inc(i);
If (i>=k) and (d>=j) then
Begin
Writeln(Out,S);
Inc(j);
End;
If d=j then CloseF;
Repeat
Gen(a);
Until Sr1;
s:=Per(a);
Until Sr(a);
CloseF;
End.

Работает она так:
имеем число 123
увеличиваем это число в 4-ной системе счисления, до тех пор, пока не получатся разные цифры. Только она не вычисляет k-тую перестановку

← →
VictorT © (2002-12-11 21:54) [4]

> имеем число 123
> увеличиваем это число в 4-ной системе счисления

У меня тот же алгоритм, хотя и сам придумал :)

← →
Uncle Archi © (2002-12-11 22:00) [5]

> имеем число 123
> увеличиваем это число в 4-ной системе счисления

У меня тот же алгоритм, хотя и сам придумал :)

А где это было раньше написано?
(Я тоже его придумал год назад на райноке по информатике)

← →
VictorT © (2002-12-11 22:13) [6]

> А где это было раньше написано?

Я лично нигде не видел, но имхо это всё-равно не оптимальный алгоритм (перебор, хотя и не полный), в теории вероятности (раздел комбинаторика) есть формула для расчёта перестановок, только не помню уже, а копатся в книге влом...

← →
Uncle Archi © (2002-12-11 22:50) [7]

На полке лежит книжка "Алгоритмы: построение и анализ"( на 960 стр.), там есть хороший алгоритм, но искать влом, хотя и мой неплохо работает.

← →
VictorT © (2002-12-12 19:35) [8]

Вот мой вариант. Компилил Turbo C++ 3.0. Если хочешь, вышлю на мыло архив с исходником и ехе-шником (размер 18 К).

#include <string.h> #include <stdio.h> char link[] = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15}; char len; unsigned long fac(char n) { if (n <= 1) return 1; unsigned long f = 1; for (char i = 1; i <= n; i++) f *= i; return f; } char check() { char flag[] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; for (char i = 0; i <= len; i++) { if (flag[link[i]] == 0) flag[link[i]] = 1; else return 1; } return 0; } void increment() { char i = len; while(1) { if (link[i] < len) { link[i] = link[i] + 1; return; } else { link[i] = 0; --i; } } } void next() { while(1) { increment(); if (check() == 0) return; } } void main(int argc, char **argv) { puts("Exange (c) Titorov Viktor"); if (argc == 2) { char *string = *++argv; len = strlen(string); if (len > 16) { puts("Длина строки не может быть больше 16."); return; } unsigned long nVar = fac(len) - 1; len--; FILE *out_file = fopen("Exange.txt", "w"); fprintf(out_file, "%s\n", string); for (unsigned long i = 1; i <= nVar; i++) { float procent = i * 100.0 / nVar; printf("%5.1f% завершено.\r", procent); next(); for (char j = 0; j <= len; j++) { fputc(string[link[j]], out_file); } fputc("\n", out_file); } fclose(out_file); puts("Результат см. в файле Exange.txt"); } else { puts("Утилитка, выдающая все варианты"); puts("перестановок заданной строки."); puts("Формат запуска: Exange.exe [string]"); } }

← →
MBo © (2002-12-12 20:13) [9]

Братцы, не издевайтесь над здравым смыслом, послушайте Игорька. Его слова, записанные в паскальном синтаксисе, дают процедуру на 5-10 строк.

← →
VictorT © (2002-12-12 20:36) [10]

> MBo © (12.12.02 20:13)

Ну и приведи этот код на 5-10 строк.

З.Ы. В моём случае приблизительно 15 вышло, вроде не издеваюсь...

← →
Oleg_Gashev © (2002-12-12 21:19) [11]

У Кнута есть два алгоритма нахождения всех перестановок.
Коды алгоритмов есть на http://algolist.manual.ru (раздел комбинаторика).
На С у меня выходило 10-15 строк, точно не помню. На С++ в STL уже есть готовая функция нахождения следующей перестановки.

Простейший алгоритм следующий.
Берем 1. Вставляем 2 в любую позицию. Получаем 12 и 21. Вставляем в полученные результаты 3. С первой перестановки получаем 312, 132, 123. Со второй 321, 231, 213. И так далее.
MBo приводил такой алгоритм на форуме.

← →
MBo © (2002-12-12 23:09) [12]

Прямая реализация [Igorek © (11.12.02 19:10)]
Привожу реализацию со строкой.

procedure TForm1.Button5Click(Sender: TObject);
var s:string;
nmax:byte;

procedure MakeIt(s:string; step:byte{Имеет индекс глубины,} );
var i:char;
begin
if step>nmax then begin //глубина зашкаливает
Memo1.Lines.Add(s);
Exit;
end;
for i:="1" to Chr(Ord("0")+nmax) do //все цифры по порядку
if Pos(i,s)=0 then begin//которые еще не использованы в предыдущих ячейках
s[step]:=i;//вставляет в ячейку соотв. глубине
MakeIt(s,step+1);//После этого вызывает сама себя
s[step]:=#0;
end;
end;

begin
nmax:=6;
setlength(s,nmax);//Делаешь глобальный масив на 6 цифр.
MakeIt(s,1);//Потом рекурсивную процедуру
end;

//а это портированный на паскаль код, о котором говорил Oleg_Gashev © (12.12.02 21:19)
procedure TForm1.Button1Click(Sender: TObject);
const
Size = 6;
type
ta = array[0..Size-1] of integer;
var
PermNum: Integer;
a: ta;

procedure InsertNumber(Number: Integer; a: ta);
var
i, t: Integer;
s: string;
begin
s := "";
if (Number - 1 = Size) then begin
Inc(PermNum);
for i:=0 to Size - 1 do
s := s + Format("%d ", [a[i]]);
Memo1.Lines.Add(s);
Exit;
end else begin
a[Number-1] := Number;
InsertNumber (Number + 1, a);
for i:=Number - 2 downto 0 do begin
t:= a[i];
a[i]:= a[i+1];
a[i+1]:= t;
InsertNumber(Number + 1, a);
end;
end;
end;

begin
Memo1.Clear;
PermNum:=0;
InsertNumber(1,a);
Memo1.Lines.Add(Format("%d permutations",[PermNum]));
end;

P.S.
Очень рекомендую при решении подобных задач хорошо обдумать, что именно происходит при переборе возможных комбинаций и как отсеиваются ненужные, и записать это
1) по-русски - документируя каждый ход мысли
2) по-английски
3) на Паскале
Каждый шаг, кроме первого - элементарный, чисто технический.

← →
Uncle Archi © (2002-12-13 21:37) [13]

>MBo

И это 10-15 строчек!?

← →
VictorT © (2002-12-13 21:42) [14]

> Uncle Archi © (13.12.02 21:37)

Не, он говорил 5-10, ну да ладно, не будем придираться :)

← →
down (2002-12-13 21:48) [15]

Либо надо добавить
MakeIt( var s:string; step:byte{Имеет индекс глубины,}),
либо убрать s[step]:=#0;

← →
MBo © (2002-12-14 06:06) [16]

>down
Правильно, s[step]:=#0; - лишнее

Комбинаторная формула A=n!/(n-m)!
n - кол-во элементов
m - кол-во цифр(здесь - 6)
Вроде бы наипростейший вариант

>Marser
Ты неправ. Приведенная тобой формула - число РАЗМЕЩЕНИЙ из n элементов по m. В данном случае нужно число ПЕРЕСТАНОВОК данного набора, которое P=n!

Мой вариант:
procedure TForm1.Button1Click(Sender: TObject); var S: string; ch: char; procedure Combine(Level: Integer); var k: Integer; begin if Level = 1 then Memo1.Lines.Add(S) else begin Combine(Level - 1); for k := Level - 1 downto 1 do begin ch := S[k]; S[k] := S[Level]; S[Level] := ch; Combine(Level - 1); ch := S[k]; S[k] := S[Level]; S[Level] := ch; end; end; end; begin S := "12345"; Combine(Length(S)); end;
:)

← →
zavdim (2002-12-16 07:40) [21]

> MBo © (16.12.02 06:10)
> >Marser
> Ты неправ. Приведенная тобой формула - число РАЗМЕЩЕНИЙ
> из n элементов по m. В данном случае нужно число ПЕРЕСТАНОВОК
> данного набора, которое P=n!

Для данного случая идет, а вот если есть одинаковые цифири?

>MBo ©
Вы не обратили внимание, что данная формула является усложнением указанной вами.
>zavdim
Есть комбинаторная формула С=..(не помню точно,гадать не буду)
Поищите в Сети.

← →
zavdim (2002-12-16 11:37) [23]

> Marser © (16.12.02 11:27)
> >MBo ©
> Вы не обратили внимание, что данная формула является усложнением
> указанной вами.

В чем заключено усложнение и почему такое замечание?

> >zavdim
> Есть комбинаторная формула С=..(не помню точно,гадать не
> буду)
> Поищите в Сети

Да че искать - и сам выпишу. Я к тому писал, что тогда ведь и алгоритм желательно поменять.

Перебор Найти похожие ветки