Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2003.01.06;
Скачать: [xml.tar.bz2];

Вниз

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

 
Сергей Макаров   (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; - лишнее





 
Igorek   (2002-12-14 11:33) [17]


> MBo © (12.12.02 23:09)

И все таки Mbo - лучший!
Где ты только время берешь для форума?


 
Marser   (2002-12-15 18:15) [18]

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


 
MBo   (2002-12-16 06:10) [19]

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


 
Alx2   (2002-12-16 07:37) [20]

Мой вариант:

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!

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


 
Marser   (2002-12-16 11:27) [22]

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


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


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

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

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

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



Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2003.01.06;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.51 MB
Время: 0.009 c
3-14934
Lifestyler.XL
2002-12-12 16:50
2003.01.06
Помогите! Как подружить MS FoxPro 2.6 for Dos c Delphi


14-15300
AL2002
2002-12-13 15:17
2003.01.06
Год козла


3-14958
4x4
2002-12-12 13:32
2003.01.06
Query в Query?


6-15182
ppcat
2002-11-06 10:20
2003.01.06
rxTray не дает Windows завершить работу


1-15153
Masya2001
2002-12-22 22:03
2003.01.06
помогите...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский