Скачать: CL | DM;

Вывод всех перестановок 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 ты прогаешь на с++?

---

← →
Sha ©   (2012-11-03 00:31) [32]

> там gorfil

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

> прогаешь

тут общаются

---

← →
Германн ©   (2012-11-03 03:25) [33]

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

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

---

← →
Sha ©   (2012-11-03 12:54) [34]

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


---

← →
Sha ©   (2012-11-04 01:54) [35]

Ускорил код [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 а в другое  К

---

← →
Sha ©   (2012-11-05 10:50) [37]

> ННН   (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

---

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

Скачать: CL | DM;



Память: 0.57 MB
Время: 0.004 c