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

Вниз

Перебор подпоследовательностей   Найти похожие ветки 

 
Igorek   (2002-12-17 16:03) [0]

В продолжение темы перебора.
Сегодня была необходимость - написал такое. Может кому-то будет интересно.
type
TGroup = record
B, E: Integer;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Count, I, N: integer;

Gs: array of TGroup;
procedure ShowLine;
var
I: Integer;
S: String;
begin
S := "";
for I := N - 1 downto 0 do
begin
if Gs[I].B = 0 then
continue;
if Gs[I].B = Gs[I].E then
S := S + IntToStr(Gs[I].B)
else
S := S + IntToStr(Gs[I].B) + "-" + IntToStr(Gs[I].E);
if I <> 0 then
S := S + ",";
end;
Memo1.Lines.Add(S);
Inc(Count);
end;
procedure Split(N1, N2, G: Integer);
var
I: Integer;
begin
if G = 1 then
begin
Gs[G - 1].B := N1;
Gs[G - 1].E := N2;
ShowLine;
Exit;
end;
for I := 0 to ((N2-N1+1) - (G-1)) - 1 do
begin
Gs[G - 1].B := N1;
Gs[G - 1].E := N1 + I;
Split(N1 + I + 1, N2, G - 1);
end;
end;
begin
Count := 0;
N := StrToInt(Edit1.Text);
SetLength(Gs, N);
Memo1.Lines.Clear;
for I := 1 to N do
Split(1, N, I);
Memo1.Lines.add("Вариантов:" + IntToStr(Count));
SetLength(Gs, 0);
end;


 
MBo   (2002-12-17 16:21) [1]

Поясни, что за последовательности получаются, plz


 
Ru   (2002-12-17 17:43) [2]

если работает помести в виде нормальной функции или процедуры на delphibase.endimus.ru (только с объяснениями)


 
Igorek   (2002-12-17 18:23) [3]


> MBo © (17.12.02 16:21)
> Поясни, что за последовательности получаются, plz

Легко же вставить в приложение и запустить. :-)

Выдает все возможные комбинации последовательных подпоследовательностей исходного набора элементов. Подпоследовательностей может быть от 1 до N. N - колл. элементов в исходной последовательности. Для каждого колличесва выдается еще и набор всех возможных комбинаций.
Сорри если непонятно - легче запустить и увидеть.


> Ru © (17.12.02 17:43)
> если работает помести в виде нормальной функции или процедуры
> на delphibase.endimus.ru (только с объяснениями)

Работает, но надо код причесать. А задача вобщем-то не супер-сложная, что-бы где-то размещать.


 
MBo   (2002-12-17 18:30) [4]

N=3

1-3
1,2-3
1-2,3
1,2,3
Вариантов:4

Что это означает?
Sorry за недопонимание


 
MBo   (2002-12-17 18:36) [5]

Т.е.
123
1 и 23
12 и 3
1 и 2 и 3
так?


 
Igorek   (2002-12-17 18:39) [6]


> MBo © (17.12.02 18:30)

Разбиение на группы.
1-3 - все три элемента в одной группе
1,2-3 - 1 - в первой, 2 и 3 - во второй
1-2,3 - 1 и 2 в первой, 3 - во второй
1,2,3 - все элементы в отдельных группах

Больше вариантов нету.
Порядок нельзя менять (т.е. не может быть 1 и 3 в одной группе, а 2 - во второй).

А вообще это возникло в связи с такой задачей:
http://www.rsdn.ru/forum/Message.aspx?mid=155378


 
Igorek   (2002-12-17 18:40) [7]


> MBo © (17.12.02 18:36)

ага


 
MBo   (2002-12-17 18:52) [8]

Оно?


procedure TForm1.Button2Click(Sender: TObject);
var i,j,n:integer;
s:string;
begin
N := StrToInt(Edit1.Text);
for i:=(1 shl (n-1))-1 downto 0 do begin
s:="";
for j:=0 to n-1 do begin
s:=s+inttostr(j+1);
if (i and (1 shl (j)))>0 then
s:=s+"-"
else
if j<n-1 then
s:=s+",";
end;
memo1.lines.add(s);
end;
end;


 
Igorek   (2002-12-17 19:04) [9]


> MBo © (17.12.02 18:52)

Вроде оно. Осталось разобраться как работатет. ;-)

З.Ы. Что-то у тебя отступы хромают. ;-)


 
MBo   (2002-12-17 19:08) [10]

двоичная система - в последовательности n чисел n-1 мест для разделения, 2^(n-1) вариантов. Биты i указывают - есть в этом месте разрыв или нет.


 
Igorek   (2002-12-17 19:21) [11]


> MBo © (17.12.02 19:08)

Проглядел я сей момент однако. :-(
Действ. и не надо никакой рекурсии.



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

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

Наверх




Память: 0.46 MB
Время: 0.009 c
4-15375
Pat
2002-11-17 14:06
2003.01.06
Как можно удалить ScrollBar ы у dbGrid?


7-15331
zalviko
2002-10-27 14:44
2003.01.06
Вопрос


14-15259
Феликс
2002-12-15 17:18
2003.01.06
Еще 1 вопрос по Перлу


1-15004
roman_tutov
2002-12-21 20:45
2003.01.06
Как подсветить новую строку в ListBox


14-15269
4D man
2002-12-16 19:13
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский