задача на перебор

← →
bogdan (2006-04-02 17:20) [0]

Привет мастера!
есть такая задачка!
дано числа p, m;
требуется сгенерировать всевозможные наборы из m+1 чисел, числа берутся целые из отрезка [0..p-1].

Например :
p=3 -> числа следующие: {0,1,2} m=например 2
значит нужно сформировать все комбинации из трех чисел:
{0,0,0}{0,0,1}{0,0,2}{0,1,0}{0,2,0}{0,1,1}{0,1,2}{0,2,1}{0,2,2} и т.д.

посмотрел задачу на algolist.manual.ru:
Сгенерировать все k-элементные подмножества множества A из N чисел, A={1, 2, ..., N}.

и решение :
---------

Воспользуемся следующим алгоритмом генерации сочетаний по k элементов из множества A:

В массиве B будут находиться индексы используемых на данном шаге элементов из A (общее их число k). В качестве начальной конфигурацией возьмем следующую: B[j]=j, j=1,...,k.

Ищем B[j] с максимальным индексом j такое, что

B[j]<n+j-k,

увеличиваем это B[j] на 1, а для всех m>j полагаем B[m]=B[m-1]+1 (B[j] растут с ростом j, и мы ищем и увеличиваем на 1 такое B[j] с максимальным номером j, чтобы при заполнении возрастающими значениями элементов массива B[m], m>j, последний элемент B[k] не превосходил бы n). Если такого B[j] не существует, то генерация сочетаний для данного k закончена.

---------
Но к сожалению я не могу понять, как это сделать на delphi и вааще этот алгоритм(индексы , проверки)!
если у вас есть какие-то наброски или обьяснения помогите плиз!

← →
MBo © (2006-04-02 17:33) [1]

рекурсивный алгоритм (менее эффективный) написать не просто, а очень просто
procedure TForm5.Button2Click(Sender: TObject); var n, p: Integer; procedure Comb(s: string; From, Level: Integer); var i: Integer; begin if Level >= n then Memo1.Lines.Add(s) else for i := From to p - 1 do Comb(s + IntToStr(i) + " ", i + 1, Level + 1); end; begin n := 3; p := 6; Comb("", 0, 0); end;

← →
bogdan (2006-04-02 22:44) [2]

> MBo © (02.04.06 17:33) [1]
> рекурсивный алгоритм (менее эффективный) написать не просто,
> а очень просто
>
> procedure TForm5.Button2Click(Sender: TObject);
> var
> n, p: Integer;
>
> procedure Comb(s: string; From, Level: Integer);
> var
> i: Integer;
> begin
> if Level >= n then
> Memo1.Lines.Add(s)
> else
> for i := From to p - 1 do
> Comb(s + IntToStr(i) + " ", i + 1, Level + 1);
> end;
>
> begin
> n := 3;
> p := 6;
> Comb("", 0, 0);
> end;
> <Цитата>

этот вариант не работает

← →
Думкин © (2006-04-03 06:30) [3]

> bogdan (02.04.06 22:44) [2]

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

← →
balepa © (2006-04-03 06:48) [4]

> bogdan (02.04.06 17:20)
> Но к сожалению я не могу понять, как это сделать на delphi
> и вааще этот алгоритм(индексы , проверки)!
> если у вас есть какие-то наброски или обьяснения помогите
> плиз!

Ты хоть раз на математику ходил - вы там что индексами не пользовались и ничего не проверяли?

← →
MBo © (2006-04-03 07:07) [5]

В первом посте у тебя описаны две разные задачи.
Я тебе дал код генерации лексикографически упорядоченных СОЧЕТАНИЙ.
Другая задача - еще проще, мог бы и сам мозгами пораскинуть:

procedure ExtraComb(s: string; Level: Integer); var i: Integer; begin if Level >= n then Memo1.Lines.Add(s) else for i := 0 to p - 1 do ExtraComb(s + IntToStr(i) + " ", Level + 1); end;

← →
bogdan (2006-04-03 15:20) [6]

пасиб мастера... разобрался!

я и не говорю что я умный! умные вы а я токо учусь!

← →
bogdan (2006-04-03 15:51) [7]

а вот еще что! каким образом завершается процедура extractcomp
я не вижу там никакого условия завершения!
обьясните плиз! а то оно работает но я не понимаю! рекурсия ж не человек, что знает когда прекратить!

пасиб

← →
MBo © (2006-04-03 15:55) [8]

>я не вижу там никакого условия завершения!
if

← →
bogdan (2006-04-03 16:01) [9]

туплю сори

← →
bogdan (2006-04-03 18:15) [10]

Я очень извиняюсь, но придется еще раз просить о помощи! я думал. что поняв выше указаный код, смогу переделать его в случай , когда каждая строка - это вектор двумерного массива , в котором m+1 столбец и соответсвенно p^m векторов-рядков! тоесть заполнять не поля мемо а в массив! но рекурсию я так и не сумел переделать! еще не дорос видать до комбинаторики(слабо у меня здесь)
впринципе я могу написать функцию, которая уже из готовых строк memo переводит числа заполняет двумерный массив, но так коряво программировать даже самому неудобно! та и скорость заметно падет при возрастании p и m!
просветите, плиз, и в этом случае!
А еще может кто-нить знает степень сложности алгоритма в даной задаче?

← →
bogdan (2006-04-03 22:12) [11]

народ откликнитесь плиз

← →
MBo © (2006-04-04 07:37) [12]

Такое впечатление, что ты не имеешь понятия о базовых элементах языка - циклах, массивах и т.п. Ну и какой смысл распинаться, если готовый код не можешь применить?

P.S. Нерекурсивный метод генерации размещений с повторениями можно реализовать как вывод p^n n-разрядных чисел в P-ричной системе счисления.

← →
bogdan (2006-04-04 15:07) [13]

вот именно не могу а не "не хочу"! если б я допер так я бы не спрашивал!
елементарные понятия я знаю! а вот с рекурсией и комбинаторикой плохо у меня, ПЛОХо!
по=этому и прошу помочь разобраться! а вы знаете и не хотите подсказать!

← →
bogdan (2006-04-06 00:00) [14]

привет! вот друг мне подсказал только превести на delphi я не умею

bool Add1(int *array,int m,int p,int degree)
{
++array[degree];//увеличиваем разряд
if(array[degree]==p)//если некуда увеличивать,
{
array[degree]=0;//сбрасываем в 0
if(degree==m)//все, прошли все m+1 разряда (от 0 до m)
return false;
else
return Add1(array,m,p,degree+1);//увеличиваем следующий разряд
}
else
return true;
}
...
//использование:
//выводим все 10-значные числа в 5-чной системе счисления
int array[10]={0,0,0,0,0,0,0,0,0,0};
while(true)
{
PrintArray(array);
if(Add1(array,9,5,0))
break;
}

← →
bogdan (2006-04-08 13:53) [15]

все я решил задание. спасибо за помощь(моральную)

>все я решил задание
Покажи, что получилось

← →
bogdan (2006-04-09 15:28) [17]

Tvect=array [0..10000000,0..10] of integer;
procedure ZAPOV_ROW(var Row:Tvect;ind_r,p,m:integer; number:int64);
var j:integer; s:int64;t1,t:integer;
begin
//m<10 + p<10
s:=number;
if (m>9)or(p>9)or(s>trunc(power(p,m+1))-1) then exit;
for j:= m+1 downto 1 do
begin
t1:= trunc(power(p,j-1));
t:= s div t1;
row[ind_r,j]:= t;
s:=s-row[ind_r,j]*t1;
end;

задача на перебор Найти похожие ветки