Генератор перестановок - Паскаль
В задачах с перебором часто возникает необходимость подсчета числа перестановок и вывода этих перестановок. Здесь приводятся примеры решения таких задач с кодами на языке Паскаль.
Как известно, число перестановок массива или вообще множества, состоящего из n элементов равно n!
Программа. Подсчет числа перестановок.
Пусть задан массив из n элементов. Получить всевозможные перестановки его элементов \(p_{i}\).
Во-первых, отсортируем этот массив в порядке убывания и полученную перестановку объявляем начальной - первой.
Во-вторых, находим наименьший индекс i из номеров 2,3,...,n, при котором \(p_{i-1}>p_{i}\) (значение i:=2).
В-третьих, находим наименьший индекс j из 1,2,...,i-1, при котором \(p_{j}>p_{i}\).
В-четвертых, обмениваем местами значения \(p_{i}\) и \(p_{j}\).
В-пятых, обмениваем значениями компоненты в парах: $$\left(p_{1},p_{i-1} \right),\left(p_{2},p_{i-2} \right),...\left(p_{k},p_{i-k} \right),\left(k=\left(i-1 \right)/2 \right)$$ В-шестых, выводим очередную сформированную перестановку и если их общее количество меньше n!, то переходим к шагу 2. В противном случае вычисления прекращаем.
Программа (1-й способ). Генератор перестановок.
Пример. Перестановки (2-й способ)
Задан массив a[1..m] попарно различных чисел. Напечатать все перестановки этих чисел.
Программа. Генерация перестановок
Как известно, число перестановок массива или вообще множества, состоящего из n элементов равно n!
Программа. Подсчет числа перестановок.
Procedure faсt(n:integer; var f:longint); var i:integer; begin f:=1; if n=0 then f:=1 else for i:=1 to n do f:=f*i end;Пример. Сгенерировать перестановки элементов.
Пусть задан массив из n элементов. Получить всевозможные перестановки его элементов \(p_{i}\).
Во-первых, отсортируем этот массив в порядке убывания и полученную перестановку объявляем начальной - первой.
Во-вторых, находим наименьший индекс i из номеров 2,3,...,n, при котором \(p_{i-1}>p_{i}\) (значение i:=2).
В-третьих, находим наименьший индекс j из 1,2,...,i-1, при котором \(p_{j}>p_{i}\).
В-четвертых, обмениваем местами значения \(p_{i}\) и \(p_{j}\).
В-пятых, обмениваем значениями компоненты в парах: $$\left(p_{1},p_{i-1} \right),\left(p_{2},p_{i-2} \right),...\left(p_{k},p_{i-k} \right),\left(k=\left(i-1 \right)/2 \right)$$ В-шестых, выводим очередную сформированную перестановку и если их общее количество меньше n!, то переходим к шагу 2. В противном случае вычисления прекращаем.
Программа (1-й способ). Генератор перестановок.
Program generator_transp;
{Генератор перестановок}
uses WinCrt;
const
n=3;
label 1;
type
u=array[1..n] of integer;
var
p:u;
i,z,y,l,v,j:integer;
{-----------------------------------------}
Procedure output_p(p:u;y,n:integer);
{Процедура вывода элементов перестановки на экран}
var
e:integer;
begin
writeln(' Перестановка элементов');
write(y, ' ':6);
for e:=1 to n do write(p[e]:4);
writeln
end;
{---------------------------------------------}
begin
writeln('Заданный массив чисел');
for i:=1 to n do
begin
p[i]:=n+1-i; {Задаются элементы массива}
write(p[i]:4)
end;
writeln;
z:=1;
for i:=1 to n do z:=z*i; {Вычисление числа перестановок}
y:=1;
output_p(p,y,n);
for y:=2 to z do {Цикл по числу перестановок}
begin
i:=2; j:=1;
while p[i-1]<=p[i] do i:=i+1;
while p[j]<= p[i] do j:=j+1;
v:=p[i]; p[i]:= p[j]; p[j]:=v;
if i=2 then goto 1;
for l:=1 to (i - 1) div 2 do
begin
v:=p[l]; p[l]:=p[i-l]; p[i-l]:=v
end;
1:output_p(p,y,n)
end
end.
В этой программе массив элементов создается уже упорядоченным по убыванию и состоит из натуральных чисел.
Пример. Перестановки (2-й способ)
Задан массив a[1..m] попарно различных чисел. Напечатать все перестановки этих чисел.
Программа. Генерация перестановок
Program perestanowki;
uses WinCrt;
const
mm=100;
var
m,i,j,k,n:integer;
a,p:array[1..mm] of integer;
begin
write('Введите число эл.для перестановки ');
readln(m);
writeln('Введите элементы массива a[1..m]');
for i:=1 to m do
begin
write('Введите ', i, '-й элемент ');
readln(a[i]);
p[i]:=i
end;
for i:=1 to m do write(a[i], ' ');
writeln;
for i:=m-1 downto 1 do
if p[i] < p[i+1] then
begin
n:=p[i];
for j:=m downto i do
if n < p[j] then
begin
p[i]:=p[j]; p[j]:=n;
k := 1;
while i+k < m-k+1 do
begin
n:=p[i+k];
p[i+k]:=p[m+1-k];
p[m+1-k]:=n;
k:=k+1
end;
j:=i
end;
for i:=1 to m do write(a[p[i]]:4);
writeln
end
end.
