| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Вывод всех перестановок k элементов из множества N имеющихся [D7]
ННН © (2012-10-28 23:00:00)Всем привет нужен алгоритм (любой на словах или кодом) выводящий все перестановки k элементов (не повторяющихся) из множества N имеющихся.
т.е. Пусть N=6, {1,2,3,4,5,6}, k=4
1 2 3 4
1 2 3 5
1 2 3 6
1 2 4 5
1 2 4 6
1 2 5 6
1 3 4 5
и т.д.
Sha (2012-11-09 21:52:00) [1]вот тут еще немного быстрее:
http://guildalfa.ru/alsha/node/26
Очень злой (2012-11-06 09:09:00) [2]М-да, а если принимать во внимание время, то все равно алгоритм Sha намного (причем очень) быстрее получается...
Очень злой (2012-11-06 01:48:00) [3]
> один из способов перечисления размещений состоит в использовании
> перестановок и сочетаний, а именно во всевозможных перестановках
> элементов каждого сочетания
Если так то:
var
n,s:string;
...
//ищем перестановки
procedure recurse2(s:string;pos:integer);
var
c:char;
i:integer;
begin
if pos>=length(s) then Form1.Memo1.Lines.Add(s)
else for i:=pos to length(s) do
begin
c:=s[pos];
s[pos]:=s[i];
s[i]:=c;
recurse2(s,pos+1);
end;
end;
// Ищем сочетания
procedure recurs(pos,start,last,endd:integer);
var
i:integer;
begin
if last>endd then recurse2(s,1)
else for i:=start to last do
begin
s[pos]:=n[i];
recurs(pos+1,i+1,last+1,endd);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
n:=Edit1.text;
setlength(s,SpinEdit1.Value);
// Memo1.Lines.Clear;
// Memo1.Lines.BeginUpdate;
recurs(1,1,length(Edit1.Text)-SpinEdit1.Value+1,Length(Edit1.text));
// Memo1.Lines.EndUpdate;
end;
Насчет скорости не замерял... да и намутил я тут, много чего неоптимально , можно улучшить,
например length(s) вычислять не нужно , так как оно всегда равно spinedit1.value, ну и еще есть чего оптимизировать
Очень злой (2012-11-06 01:21:00) [4]Попробовал запустить код Sha, и понял что я неправильно понял условие...
Сейчас еще подумаю
Очень злой (2012-11-06 00:55:00) [5]Вроде так... Правда порядок определяется порядком следования символов в Edit1
например:
Edit1.text='abcd6r' K=4
abcd
abc6
abcr
abd6
abdr
ab6r
acd6
acdr
ac6r
ad6r
bcd6
bcdr
bc6r
bd6r
cd6r
Очень злой (2012-11-06 00:46:00) [6]Представил себе эту ветку в виде пятничной задачки. :)
Посему и захотелось ее решить.
По первому посту не совсем понял задачу, в приведенных кодах не разбирался, ссылки не читал, но судя по примерам того что должны мы получать, задачу я понял так: Нужно получить все (не помню что такое перестановка, скажу по другому) комбинации K неповторяющихся элементов из множества N-элементов, причем идущих всегда в одном порядке (например алфавитном).
У меня получилось такое:
В Edit1 вбиваем последовательность нужных элементов
соответственно его длина это будет N
В spinedit1 вбиваем значение K
var
n,s:string;
...
procedure recurs(pos,start,last,endd:integer);
var
i:integer;
begin
if last>endd then Form1.Memo1.Lines.add(s)
else for i:=start to last do
begin
s[pos]:=n[i];
recurs(pos+1,i+1,last+1,endd);
end;
end;
...
procedure TForm1.Button1Click(Sender: TObject);
begin
n:=Edit1.text;
setlength(s,SpinEdit1.Value);
recurs(1,1,length(Edit1.Text)-SpinEdit1.Value+1,Length(Edit1.text));
end;
и получаем все в memo1
ННН (2012-11-05 14:51:00) [7]Вот эту строчку надо изменить, s2[i]:=Edit1.Text[1]
for i:=1 to n do s2[i]:=AnsiChar(Ord('a')-1+i);
как то так) ладно в конце недели сделаю как курсач сдам
Sha (2012-11-05 10:50:00) [8]> ННН (05.11.12 10:16) [36]
Совсем небольшое изменение. Пусть это будет домашнее задание.
ННН (2012-11-05 10:16:00) [9]да работает вроде как сильно шустро)) а что если его доработать, чтобы он работал со строкой, т.е. в одно поле вводишь строку 234 а в другое К
Sha (2012-11-04 01:54:00) [10]Ускорил код [34] еще примерно на 20% для больших n, k:
(проц=E6850, n=13, k=12, t=42 sес)
procedure GenerateArrangements3(n, k: integer);
var
i, len: integer;
s1, s2: string[255];
ch: AnsiChar;
begin;
if (k<=0) or (n<k) or (n>255) then exit;
SetLength(s1,k);
SetLength(s2,n);
for i:=1 to n do s2[i]:=AnsiChar(Ord('a')-1+i);
i:=n;
len:=0;
while true do begin;
s1[len+1]:=s2[i];
inc(len);
s2[i]:=s2[len]; //заменить на сдвиг, если нужен алфавитный порядок
s2[len]:=AnsiChar(i);
i:=n;
if len=k then begin;
//Form1.Memo1.Lines.Add(s1);
while true do begin;
i:=Ord(s2[len]);
s2[len]:=s2[i]; //заменить на сдвиг, если нужен алфавитный порядок
s2[i]:=s1[len];
dec(len);
dec(i);
if i>len then break
else if i>0 then continue
else exit;
end;
end;
end;
end;
Sha (2012-11-03 12:54:00) [11]В коде ниже используется тот же самый наивный подход к перебору размещений, что и в алгоритме gorfil.
Отличия:
1) нет рекурсии,
2) вместо сцепления строк работаем с блоком символов переменной длины внутри строки,
3) в качестве стека используется часть строки, не занятая этим блоком,
4) неалфавитный порядок генерации, т.к. вместо сдвига блока символов
используется перемещение крайнего символа на свободное место.
В результате получена совсем не плохая скорость: 11! перестановок за ~0.5 сек.
Алгоритм можно еще немного ускорить, но не думаю, что больше чем на 10%
procedure GenerateArrangements2(n, k: integer);
var
i, len1, len2: integer;
s1, s2: string[255];
begin;
if (k<=0) or (n<k) then exit;
SetLength(s1,k);
SetLength(s2,n);
for i:=1 to n do s2[i]:=AnsiChar(Ord('a')-1+i);
i:=1;
len1:=0;
len2:=n;
while true do begin;
s1[len1+1]:=s2[i];
s2[i]:=s2[len2]; //заменить на сдвиг, если нужен алфавитный порядок
s2[len2]:=AnsiChar(i);
inc(len1);
dec(len2);
i:=1;
if len1=k then begin;
//Form1.Memo1.Lines.Add(s1);
repeat;
if len1=0 then exit;
i:=Ord(s2[len2+1]);
s2[len2+1]:=s2[i]; //заменить на сдвиг, если нужен алфавитный порядок
s2[i]:=s1[len1];
inc(len2);
inc(i);
dec(len1);
until i<=len2;
end;
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
var
t: cardinal;
begin;
t:=GetTickCount;
GenerateArrangements2(11, 11);
t:=GetTickCount-t;
Memo1.Lines.Add(IntToStr(t)+' msec');
end;
Германн (2012-11-03 03:25:00) [12]
> ННН (03.11.12 00:08) [31]
>
> Sha ты прогаешь на с++?
>
Си и Си++ тут многие знают. Особенно Си. Есть "специальные" вопросы по Си++? Так задавай их.
А "прогают" только некоторые вроде тебя.
Sha (2012-11-03 00:31:00) [13]> там gorfil
идея алгоритма gorfil очень хороша,
после оптимизации вполне может оказаться быстрее, чем [29]
> прогаешь
тут общаются
ННН (2012-11-03 00:08:00) [14]Sha ты прогаешь на с++?
ННН (2012-11-03 00:08:00) [15]Sha))) Спасибо за участие! даже лучше сказать за потраченное время на меня. Зайди на
"Вероятно, ты о варианте (TStringList,Sorted=true,Duplicates=dupIgnore),
который тебе предложили на другом форуме." там gorfil тоже очень хорошо поработал))
Sha (2012-10-31 20:56:00) [16]Теперь решение, правда довольно сырое,
но при желании его можно оптимизировать и получить вполне приличное.
В духе этого кода используемые цифры начинаются с 0, а не с 1.
Если требуется работать с k>9, надо переписать процедуру ShowArrangement ))
type
TPermutation= array of integer;
TArrangement= array of integer;
TCombinations= array of TArrangement;
function GenerateCombinations(n, k: integer): TCombinations;
var
i, j, start, delta: integer;
begin;
if (k<=0) or (n<k) then exit;
i:=1; for j:=0 to k-1 do i:=i * (n-j) div (j+1);
SetLength(Result, i, k);
i:=0; for j:=0 to k-1 do Result[i,j]:=j;
start:=k-1;
if k<n then while true do begin; //если существует более одного сочетания крутим цикл
if Result[i,k-1]<n-1
then start:=k-1
else begin;
dec(start); if start<0 then break;
end;
inc(i);
delta:=Result[i-1,start]-start+1;
for j:=k-1 downto start do Result[i,j]:=j+delta;
for j:=start-1 downto 0 do Result[i,j]:=Result[i-1,j];
end;
end;
procedure ShowArrangement(const Arrangement: TArrangement);
var
j, val: integer;
begin;
if Length(Arrangement)>9 then exit;
val:=1;
for j:=0 to Length(Arrangement)-1 do val:=val*10+Arrangement[j];
Form1.Memo1.Lines.Add(Copy(IntToStr(val),2,255));
end;
procedure ShowArrangements(const Permutation: TPermutation; const Combinations: TCombinations);
var
Arrangement: TArrangement;
i, j: integer;
begin;
SetLength(Arrangement,Length(Permutation));
for i:=0 to Length(Combinations)-1 do begin;
for j:=0 to Length(Arrangement)-1 do Arrangement[j]:=Combinations[i,Permutation[j]];
ShowArrangement(Arrangement);
end;
end;
procedure GenerateArrangements(n, k: integer);
var
Combinations: TCombinations;
Permutation: TPermutation;
ExchangeIndex: array of integer;
i, j, level, temp: integer;
begin;
if (k<=0) or (n<k) then exit;
Combinations:=GenerateCombinations(n, k);
SetLength(Permutation,k);
SetLength(ExchangeIndex,k);
for i:=0 to k-1 do begin;
Permutation[i]:=i;
ExchangeIndex[i]:=i;
end;
ShowArrangements(Permutation, Combinations); //показываем сочетания для тождественной перестановки
level:=k-2;
//генерируем перестановки
while true do begin;
i:=ExchangeIndex[level]+1; //позиция символа, который поставим на место level
if i<k then begin; //допустимая? т.е. из диапазона level+1..k-1?
ExchangeIndex[level]:=i; //сохранили новое значение, не меняем символы Permutation[0..level]
i:=level+1; j:=k-1;
repeat;
//инвертируем порядок символов Permutation[level+1..k-1]
temp:=Permutation[j]; Permutation[j]:=Permutation[i]; Permutation[i]:=temp;
inc(i); dec(j);
until i>=j;
//обмен Permutation[level] и Permutation[ExchangeIndex[level]]
i:=ExchangeIndex[level];
temp:=Permutation[i]; Permutation[i]:=Permutation[level]; Permutation[level]:=temp;
level:=k-2;
ShowArrangements(Permutation, Combinations); //сочетания для очередной перестановки
end
else begin;
ExchangeIndex[level]:=level;
dec(level);
if level<0 then break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin;
GenerateArrangements(6, 4);
end;
Sha (2012-10-31 20:41:00) [17]Сначала приведу нечто, которое ничуть не хуже того, что тебе дали.
Решением это назвать нельзя, т.к. оно перебирает слишком много лишнего, прежде чем найдет нужное:
procedure TForm1.Button3Click(Sender: TObject);
const
maxcipher= 9;
power: array[0..maxcipher-1] of integer= (1, 2, 4, 8, 16, 32, 64, 128, 256);
var
i, j, k, n, max, num, cip, tmp, used, count: integer;
s: string[maxcipher];
begin;
n:=6; k:=4;
//------------------
count:=0;
if (1<=k) and (k<=n) and (n<=maxcipher) then begin;
SetLength(s,k);
max:=1;
for i:=1 to k do max:=max * n;
for i:=0 to max-1 do begin;
used:=0;
num:=i;
j:=k;
repeat;
tmp:=num div n;
cip:=num - tmp * n;
if used and power[cip]<>0 then break;
used:=used or power[cip];
s[j]:=AnsiChar(cip+Ord('1'));
num:=tmp;
dec(j);
until j=0;
if j=0 then begin;
inc(count);
Memo1.Lines.Add(s);
end;
end;
end;
Memo1.Lines.Add('total='+IntToStr(count));
end;
ННН (2012-10-31 16:00:00) [18]))
Sha (2012-10-31 15:35:00) [19]
> ННН (31.10.12 15:26) [25]
как дома будет время, напишу что-нибудь, как-то так )
ННН (2012-10-31 15:26:00) [20]учитывая то что я не прогал 7 лет, и понятия не имел без практики как работают рекурсивные функции + мозг был вынесен реализацией проекта после длительного отдыха и он был готов за исключением данного алгоритма, то я бы назвал это помощью, а если учитывать что я окончательно разобрался и прорешал весь алгоритм на листочке, то можно назвать это и решением
как то так
| |
Страницы: 