{ АЛГОРИТМИ ЗА ПЕРМУТАЦИИ, КОМБИНАЦИИ И ДРУГИ ------------------------------------------- Програма за генериране на всички пермутации на дадено множество от еле- менти P от произволен тип DataType по метода пряка размяна. Съдържа про- цедури за кодиране и декодиране на перутации с число в лексикографически ред. Съдържа кодиране и декодиране на комбинации и вариации без повторе- ния също в лексикографически ред. Има и процедура за лексикографско ко- диране на подмножества на дадено множество. Комбинация от N елемента, K-ти клас наричаме всяко подмножество на N-те елемента с мощност K. Става въпрос за комбинации без повторение. Напри- мер ако N=5, K=3 комбинациите са 10 на брой: 1 2 3 1 2 4 1 2 5 1 3 4 1 3 5 1 4 5 2 3 4 2 3 5 2 4 5 3 4 5 Броят на комбинациите от N елемента, K-ти клас е равен на ( N ) N над K , което е равно на N!/(K!*(N-K)!) ( K ) Вариации без повторение на N елемента, K-ти клас наричаме всяко подреде- но подмножество на N, съдържащо K елемента.Броят на вариациите на N еле- мента, K-ти клас е N!/(N-K)!. Например ако имаме N=5 и K=3, вариациите са 60 на брой: 1 2 3 1 3 2 2 1 3 2 3 1 3 1 2 3 2 1 1 2 4 1 4 2 2 1 4 2 4 1 4 1 2 4 2 1 1 2 5 1 5 2 2 1 5 2 5 1 5 1 2 5 2 1 1 3 4 1 4 3 3 1 4 3 4 1 4 1 3 4 3 1 1 3 5 1 5 3 3 1 5 3 5 1 5 1 3 5 3 1 1 4 5 1 5 4 5 1 4 5 4 1 4 5 1 4 1 5 2 3 4 2 4 3 3 2 4 3 4 2 4 2 3 4 3 2 2 3 5 2 5 3 3 2 5 3 5 2 5 2 3 5 3 2 2 4 5 2 5 4 5 2 4 5 4 2 4 5 2 4 2 5 3 4 5 3 5 4 5 3 4 5 4 3 4 5 3 4 3 5 Интересна е задачата за намиране на всички различни пермутации на множес- тво от елементи, между които може да има еднакви елементи. Идеята е да се използва същият алгоритъм, но да се внимава да не се прави размяна на еле- менти, при която един елемент прескача или се разменя с еднакъв на него елемент. Това гарантира, че в крайна сметка няма да се получат еднакви пермутации. Реализацията е процедурата PermSPovtorenia. PermNezavisimiCikli представя пермутация като произведение на независими цикли. Цикъл означава поредицата i1,i2,...ik, за която P[i1]=i2, P[i2]=i3, .... P[i(k-1)]=ik, P[ik]=i1. Представяне като произведение на независими цикли означава да се намерят всички цикли в една пермутация. Например ако имаме пермутацията (4,3,5,6,2,1,7), представянето и е (146)(235)(7). Трябва да отбележим, че четността на една пермутация се определя от броя независими цикли с нечетна дължина. Четност на пермутация е четността на броя двойки (P[i],P[j]), за които iP[j]. Код на Грей се нарича алгоритъмът за пораждане на всички подмножества на дадено N-елементно множество като всеки две поредни подмножества се раз- личават едно от друго само с един бит. (Подмножествата всъщност са всички двоични числа състоящи се от N бита). Трябва да се отбележи, че кодът на Грей представлява хамилтонов път (може да се ползва и за цикъл) в N-мерен булев куб. Реализацията е в процедурата GrayCode. } CONST MaxN = 100; TYPE DataType = byte; {Тип данни за пермутиране} Masiv = array[0..MaxN] of DataType; {Тип пермутация} VAR P: Masiv; {Масив за получаване на пермутациите} Swp: DataType; {Използва се за размяна на елементи} N: byte; {Брой елементи за пермутиране} Procedure Print; Begin for N:=1 to N do Write(P[N],' '); WriteLn;{} End; Procedure Perm(K:byte); {Пермутира първите K елемента на масива P} Var I: byte; {с пряка размяна} Begin if K=1 then Print {Намерена е поредната пермутация} else begin Perm(K-1); for I:=1 to K-1 do begin Swp:=P[I]; P[I]:=P[K]; P[K]:=Swp; Perm(K-1); Swp:=P[I]; P[I]:=P[K]; P[K]:=Swp; end; end; End; Procedure LeksPerm; {Лексикографско пораждане на пермутации} Var I,J,Min: integer; Begin for N:= 0 to N do P[N]:=N; repeat Print; {извеждаме поредното решение на екрана} {търсим първото I отдясно-наляво, за което P[I] < P[I+1]} I:= N-1; while (P[I] > P[I+1]) and (I > 0) do Dec(I); if I = 0 then Break; {няма такова I --> край на алгоритъма} {разменяме местата на P[I] и P[J]; P[J]=min(P[I+1],...,P[N]), P[J]>P[I]} Min:= I+1; for J:= I+2 to N do if (P[J] < P[Min]) and (P[J] > P[I]) then Min := J; Swp:=P[I]; P[I]:=P[Min]; P[Min]:=Swp; {обръщаме последователността на P[I+1], P[I+2],...,P[N]} for J:= 1 to ((N-I) div 2) do begin Swp:=P[I+J]; P[I+J]:=P[N-J+1]; P[N-J+1]:=Swp; end; until false; End; Procedure PermNezavisimiCikli; Var I,J: integer; Used: array[1..MaxN] of boolean; Begin FillChar(Used,SizeOf(Used),false); for I:= 1 to N do If not Used[I] then begin Write('(',I); J := P[I]; while J <> I do begin Write(',',J); Used[J]:=true; J:=P[J] end; Write(')') end; WriteLn End; Procedure PermSPovtorenia(K:byte); {Пермутира първите K елемента на масива P, като P може да има еднакви ел.} Function CanExchange(I,K:byte): boolean; Begin for K:= I+1 to K do if P[I] = P[K] then begin CanExchange:=false; Exit; end; CanExchange:=true; End; Var I: byte; Begin if K=1 then Print {Намерена е поредната пермутация} else begin PermSPovtorenia(K-1); for I:=1 to K-1 do if CanExchange(I,K) then begin Swp:=P[I]; P[I]:=P[K]; P[K]:=Swp; PermSPovtorenia(K-1); Swp:=P[I]; P[I]:=P[K]; P[K]:=Swp; end; end; End; Function CodePerm(N:byte; var Perm:Masiv): longint; {Връща поредния номер} Var P: Masiv; {на пермутацията Perm в лексикографски ред (от 0 до N!-1) } I,Razl,Poz: byte; Rezult: longint; Begin Rezult:=0; for I:= 1 to N do P[I]:=I; for Poz:= 1 to N do begin Razl:=1; while Perm[Poz]<>P[Razl] do Inc(Razl); Rezult:= Rezult*(n-Poz+1) +Razl-1; for I:= Razl+1 to N do P[I-1]:=P[I]; end; CodePerm:=Rezult; End; Procedure DecodePerm(Code:longint; N:byte; var Perm:Masiv); {По зададен} Var I,Poz,Razl: byte; {пореден номер на пермутация, намира пермутацията} P: Masiv; {Номерът е в лексикографски ред в диапазона от 0 до N!-1 } Begin for I:= 1 to N do P[I]:=I; for Poz:= N downto 1 do begin Razl:=n-Poz+1; Perm[Poz]:=Code mod Razl; Code:=Code div Razl; end; for Poz:= 1 to N do begin Razl:=Perm[Poz]+1; Perm[Poz]:=P[Razl]; for I:= Razl+1 to N do P[I-1]:=P[I]; end; End; Function CodeComb(N,K:integer; var Comb:Masiv): longint; {Връща поредния} Var Cod: longint; {номер в лексикографически ред на комбинацията без} d,i,j,m,q,s: word; {повторения Comb} Begin Cod:=0; if k=0 then d:=0 else d:=Comb[1]-1; for I:= 1 to k-1 do begin Dec(n); q:=k-I; for J:= 1 to d do begin s:=1; for m:= 1 to n-q do s:= s*(q+m) div m; Inc(Cod,s); Dec(n); end; d:=Comb[I+1]-Comb[I]-1; end; CodeComb:=Cod+d; End; Procedure DecodeComb(Code:longint; N,K:word; var Comb:Masiv); {По зададен} Var I,d,m,r,s: word;{пореден номер Code връща комбинацията без повторения} Begin {съответстваща в лексикографически ред на този номер} d:=0; for I:= 1 to k do begin Dec(n); Dec(k); r:=0; Comb[I]:=0; repeat s:=1; for m:= 1 to n-k do s:= s*(k+m) div m; if Code>=r+s then begin Dec(n); Inc(r,s); Inc(Comb[I]); s:=0; end; until CodeV[l] then Dec(j); Cod:=(n-I)*Cod+j-1; end; CodeVariacii:=Cod; End; Procedure DecodeVariacii(Cod:longint; n,k:word; var V:Masiv); {По зададен} Var i,j: word; {пореден номер на вариация без повторения връща вариацията} Begin for I:= k downto 1 do begin V[I]:=Cod mod (n-I+1)+1; Cod:=Cod div (n-I+1); for J:= I+1 to K do if V[J]>=V[I] then Inc(V[J]); end; End; Function ZnakPerm(N:byte; var P:Masiv): shortint; {Връща знака на пермутация} Var Sgn: shortint; I,j: byte; Used: Masiv; Begin Sgn:=1; for I:= 1 to N do Used[I]:=0; for I:= 1 to N do if Used[I]=0 then begin j:=P[I]; while j<>I do begin Used[j]:=1; Sgn:=-Sgn; j:=P[j]; end; end; ZnakPerm:=Sgn; End; Function CodSubset(N,Poz:word; var X:Masiv): longint; { Подмножествата на първите N числа номерираме лексикографски по следния начин: Подреждаме първо по първия елемент, после по втория и т.н. Например при N=4 множествата се номерират и се представят булево така: номер множество булево представяне ------|------------|------------------- 1 - [] 0 0 0 0 2 - [1] 1 0 0 0 3 - [1,2] 1 1 0 0 4 - [1,2,3] 1 1 1 0 5 - [1,2,3,4] 1 1 1 1 6 - [1,2,4] 1 1 0 1 7 - [1,3] 1 0 1 0 8 - [1,3,4] 1 0 1 1 9 - [1,4] 1 0 0 1 10 - [2] 0 1 0 0 11 - [2,3] 0 1 1 0 12 - [2,3,4] 0 1 1 1 13 - [2,4] 0 1 0 1 14 - [3] 0 0 1 0 15 - [3,4] 0 0 1 1 16 - [4] 0 0 0 1 По зададено N и булево представяне на множество, да се намери лексикограф- ския му номер. Функцията CodSubset(N,1,Boolean_Subset) връща този номер. } Var R: longint; i: byte; Begin if N = 2 then begin CodSubset:= -2*X[Poz]*X[Poz+1] + X[Poz] + 3*X[Poz+1] + 1; Exit; end; R:=1; for i:= Poz+1 to Poz+N-1 do R:=R*(1-X[i]); CodSubset:= R*X[Poz] + (1-R) * ( (1 shl (N-1)) * (1-X[Poz]) + X[Poz] ) + CodSubset(N-1,Poz+1,X); End; Procedure CombCycles(Min,Max:integer); { Генерира комбинации като имитира N вложени цикъла от Min до Max } Var I: integer; Begin FillChar(P,SizeOf(P),Min); repeat Inc(P[N]); I:=N; while P[I] > Max do begin P[I]:=Min; Dec(I); if I > 0 then Inc(P[I]) else Exit; end; Print; until false; End; Procedure GrayCode; Var i,j,k: longint; Begin FillChar(P,SizeOf(P),0); i:=0; repeat Print; Inc(i); k:=1; j:=i; while j mod 2 = 0 do {i = j^(k-1)} begin j:= j div 2; Inc(k); end; if k <= N then P[k]:= P[k] xor 1; until k > N; End; BEGIN N:=4; p[1]:=4; p[2]:=1; p[3]:=3; p[4]:=2; GrayCode; END.