Вывод всех перестановок k элементов из множества N имеющихся

← →
ННН (2012-10-28 23:00) [0]

Всем привет нужен алгоритм (любой на словах или кодом) выводящий все перестановки 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-10-28 23:31) [1]

Если на пальцах:
в цикле генерируешь перестановки элементов abcd
и во вложенном выбираешь цифры и заменяешь ими буквы.

Ну или наоборот, если надо поменять вложенность циклов.

← →
Sha © (2012-10-28 23:41) [2]

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

← →
Sha © (2012-10-29 00:10) [3]

Псевдокод
A: array of integer; //перестановки элементов [0..k-1] P: array of integer; //перестановки k элементов твоего множества C: array of array of integer; //все сочетания из n по k элементов твоего множества ...... while NextPermutation(A) do begin; for i:=0 to Length(C)-1 do begin; for j:=0 to Length(C[0])-1 do P[j]:=C[i,A[j]]; //Show P here end; end;

← →
ННН (2012-10-29 00:23) [4]

Program perms;
var
i, j, h, n, k: integer;
a:array[0 .. 100] of integer; { массив для хранения перестановки }

{процедура вывода полученной перестановки}
procedure output;
var i: integer;
begin
writeln;
for i:=1 to n do write(a[i]," ");
end;

begin
write("количество элементов перестановки: "); readln(n);
fillchar(a, sizeof(a), 0);

{ ввод элементов начальной перестановки }
for i:=1 to n do a[i]:=i;

repeat
output; { вывод текущей перестановки }
i:=n;
while a[i-1]>a[i] do dec(i); { поиск скачка }
j:=i-1;
h:=a[j];
while a[i+1]>h do inc(i); { поиск первого меньшего элемента }
a[j]:=a[i]; a[i]:=h;
i:=j+1; k:=n;
while i<k do begin { перестановка ”хвоста” }
h:=a[i]; a[i]:=a[k]; a[k]:=h;
inc(i); dec(k)
end
until j=0;
end.

а как тут реализовать ?

← →
Sha © (2012-10-29 07:20) [5]

а как у меня реализовано тебе понятно?

← →
ННН (2012-10-29 12:00) [6]

не совсем)

← →
oldman © (2012-10-29 13:49) [7]

> т.е. Пусть 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

Таки 1 3 4 2 !!!

← →
oldman © (2012-10-29 13:50) [8]

Или 1 2 3 4 = 1 3 4 2 ???

← →
Sha © (2012-10-29 15:14) [9]

> ННН (29.10.12 12:00) [6]
> не совсем)

1. Заранее генерием все упорядоченные сочетания из n по k (в нашем случае их будет ровно 15 штук). Для правильной работы алгоритма важно, чтобы элементы в каждом сочетании были одинаково упорядочены (по возрастанию или убыванию).

2. Генерируем очередную перестановку четырех чисел. Но это не перестановка твоих элементов, это просто перестановка четырех последовательных чисел - номеров позиций (индексов). Во вложенном цикле генерируем 15 перестановок твоих элементов, соответствующих только что полученной перестановке индексов. Для этого пробегаемся по всем сочетаниям и подменяем полученные индексы элементами на соответствующих местах в очередном сочетании.

Если остались неясности, спрашивай.

← →
ННН (2012-10-29 17:06) [10]

> т.е. Пусть 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

тут будет не 15 перестановок!
если допустим 3 по 2
12
13
21
23
31
32

← →
Sha © (2012-10-29 17:28) [11]

исходной перестановке индексов:
1234
соответствуют 15 перестановок твоих элементов,
это в точности все предварительно сгенерированные сочетания:
1) 1234
2) 1235
3) 1236
4) 1245
5) 1246
6) 1256
7) 1345
8) 1346
9) 1356
10) 1456
11) 2345
12) 2346
13) 2356
14) 2456
15) 3456

← →
QAZ5 (2012-10-29 17:30) [12]

число перестановок равно факториалу числа цифр

← →
ННН (2012-10-29 18:29) [13]

это число сочетаний а не всех возможных перестановок!! не путайте ))
вот я нашёл код того что нужно, можете там посмотреть, единственное что я не шарю в С++, может кто нибудь сможет перевести на делфи ?
http://pastebin.com/ggzJ2dcB

← →
Sha © (2012-10-29 19:16) [14]

зачем что-то там переводить, проще самому написать несколько строчек

← →
ННН (2012-10-29 19:16) [15]

вот есть код, (делает всевозможные перестановки символов строки) надо его переделать под заданную задачу выводить перестановки по К элементов

procedure TForm1.Button1Click(Sender: TObject);
var
sl :TStringList;

procedure Gen(S0,S1 : string); //S1 - 2
var
i :integer;
begin
if length(S1) > 1 then //Возвращает число элементов в массиве или строке
for i:=1 to length(S1) do
Gen(S0+S1[i],copy(S1,1,i-1) + copy(S1,i+1,length(S1)))
//copy создает новую строку из части существующей строки
//имя строки
//с этого элемента
//+ столько элементов
else
sl.Add(S0+S1); //Добавляет данную строку в список, возвращая ее позицию в списке (начинается с 0).
end;

//ген(0, (1,2) )
//2>1
//от 1 до 2 Ген(1,2), Ген()

begin
sl:= TStringList.Create; // Определение объекта списка строк, и указание нашей переменной на него
sl.Sorted:= True; //Когда true, все строки будут добавляться в свою позицию отсортированной последовательности.
sl.Duplicates:= dupIgnore; //dupIgnore Игнорирует (отбрасывает) дубликаты
Gen("",Edit1.Text); //S0 =0, S1 = Edit1.Text
ListBox1.Items.Assign(sl); //Метод Assign Заменяет текущий список содержанием другого списка.
sl.Free ; //просто очистит список и строки
ShowMessage(IntToStr(Form1.ListBox1.Items.Count));
end;

end.

← →
Sha © (2012-10-29 19:26) [16]

что мешает? см. [1],[2],[3],[9],[11]

← →
han_malign (2012-10-30 10:23) [17]

> это число сочетаний а не всех возможных перестановок!! не путайте ))

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

← →
Sha © (2012-10-30 11:12) [18]

> han_malign (30.10.12 10:23) [17]

автор не путает, он все правильно понимает: один из способов перечисления размещений состоит в использовании перестановок и сочетаний, а именно во всевозможных перестановках элементов каждого сочетания

← →
QAZ5 (2012-10-30 15:42) [19]

главное не путать теплое с мягким

← →
Romkin © (2012-10-30 15:57) [20]

http://forum.sources.ru/index.php?showtopic=330364

← →
Sha © (2012-10-30 21:06) [21]

> Romkin © (30.10.12 15:57) [20]

похоже, что первый приведенный алгоритм не работает при n=k

← →
ННН (2012-10-31 11:32) [22]

всем большое спасибо за участие) всё получилось с помощью одного человека)

← →
Sha © (2012-10-31 13:45) [23]

> Romkin © (30.10.12 15:57) [20]

у Липского та же ошибка, алгоритм 1.16 не работает при n=k>1

← →
Sha © (2012-10-31 14:09) [24]

> ННН (31.10.12 11:32) [22]

Вероятно, ты о варианте (TStringList,Sorted=true,Duplicates=dupIgnore),
который тебе предложили на другом форуме.

Я бы не назвал это ни решением, ни помощью.

← →
ННН (2012-10-31 15:26) [25]

учитывая то что я не прогал 7 лет, и понятия не имел без практики как работают рекурсивные функции + мозг был вынесен реализацией проекта после длительного отдыха и он был готов за исключением данного алгоритма, то я бы назвал это помощью, а если учитывать что я окончательно разобрался и прорешал весь алгоритм на листочке, то можно назвать это и решением
как то так

← →
Sha © (2012-10-31 15:35) [26]

> ННН (31.10.12 15:26) [25]

как дома будет время, напишу что-нибудь, как-то так )

← →
ННН (2012-10-31 16:00) [27]

))

← →
Sha © (2012-10-31 20:41) [28]

Сначала приведу нечто, которое ничуть не хуже того, что тебе дали.
Решением это назвать нельзя, т.к. оно перебирает слишком много лишнего, прежде чем найдет нужное:

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;

← →
Sha © (2012-10-31 20:56) [29]

Теперь решение, правда довольно сырое,
но при желании его можно оптимизировать и получить вполне приличное.
В духе этого кода используемые цифры начинаются с 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;

← →
ННН (2012-11-03 00:08) [30]

Sha))) Спасибо за участие! даже лучше сказать за потраченное время на меня. Зайди на
"Вероятно, ты о варианте (TStringList,Sorted=true,Duplicates=dupIgnore),
который тебе предложили на другом форуме." там gorfil тоже очень хорошо поработал))

← →
ННН (2012-11-03 00:08) [31]

Sha ты прогаешь на с++?

> там gorfil

идея алгоритма gorfil очень хороша,
после оптимизации вполне может оказаться быстрее, чем [29]

> прогаешь

тут общаются

> ННН (03.11.12 00:08) [31]
>
> Sha ты прогаешь на с++?
>

Си и Си++ тут многие знают. Особенно Си. Есть "специальные" вопросы по Си++? Так задавай их.
А "прогают" только некоторые вроде тебя.

В коде ниже используется тот же самый наивный подход к перебору размещений, что и в алгоритме 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;

Ускорил код [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;

← →
ННН (2012-11-05 10:16) [36]

да работает вроде как сильно шустро)) а что если его доработать, чтобы он работал со строкой, т.е. в одно поле вводишь строку 234 а в другое К

> ННН (05.11.12 10:16) [36]

Совсем небольшое изменение. Пусть это будет домашнее задание.

← →
ННН (2012-11-05 14:51) [38]

Вот эту строчку надо изменить, s2[i]:=Edit1.Text[1]
for i:=1 to n do s2[i]:=AnsiChar(Ord("a")-1+i);
как то так) ладно в конце недели сделаю как курсач сдам

← →
Очень злой (2012-11-06 00:46) [39]

Представил себе эту ветку в виде пятничной задачки. :)
Посему и захотелось ее решить.

По первому посту не совсем понял задачу, в приведенных кодах не разбирался, ссылки не читал, но судя по примерам того что должны мы получать, задачу я понял так: Нужно получить все (не помню что такое перестановка, скажу по другому) комбинации 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-06 00:55) [40]

Вроде так... Правда порядок определяется порядком следования символов в Edit1

например:
Edit1.text="abcd6r" K=4

abcd abc6 abcr abd6 abdr ab6r acd6 acdr ac6r ad6r bcd6 bcdr bc6r bd6r cd6r

← →
Очень злой (2012-11-06 01:21) [41]

Попробовал запустить код Sha, и понял что я неправильно понял условие...
Сейчас еще подумаю

← →
Очень злой (2012-11-06 01:48) [42]

> один из способов перечисления размещений состоит в использовании
> перестановок и сочетаний, а именно во всевозможных перестановках
> элементов каждого сочетания

Если так то:

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 09:09) [43]

М-да, а если принимать во внимание время, то все равно алгоритм Sha намного (причем очень) быстрее получается...

вот тут еще немного быстрее:

http://guildalfa.ru/alsha/node/26

Вывод всех перестановок k элементов из множества N имеющихся Найти похожие ветки