
Код
{ программа генерации перестановок N элементного
множества в лексикографическом порядке }
Program perms;
var
i, j, h, n, k, count: integer;
a:array[0 .. 100] of integer; { массив для хранения перестановки }
{процедура вывода полученной перестановки}
procedure output;
var i: integer;
begin
writeln;
for i:=1 to n do write(a[i],' ');
end;
function testposition:boolean;
var
ta:array [0..100] of boolean;
i: integer;
begin
fillchar(ta, sizeof(ta), false);
for i:=1 to n do
begin
if (ta[(a[i] - i + n) mod n] = false) then
ta[(a[i] - i + n) mod n]:=true
else
begin
Result:=false;
Exit;
end;
Result:=true;
end;
end;
begin
write('количество элементов перестановки: ');
readln(n);
fillchar(a, sizeof(a), 0);
count:=0;
{ ввод элементов начальной перестановки }
for i:=1 to n do a[i]:=i;
i:=n;
j:=i;
repeat
//output; { вывод текущей перестановки }
if testposition then
inc(count);
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;
writeln(count);
readln;
end.
множества в лексикографическом порядке }
Program perms;
var
i, j, h, n, k, count: integer;
a:array[0 .. 100] of integer; { массив для хранения перестановки }
{процедура вывода полученной перестановки}
procedure output;
var i: integer;
begin
writeln;
for i:=1 to n do write(a[i],' ');
end;
function testposition:boolean;
var
ta:array [0..100] of boolean;
i: integer;
begin
fillchar(ta, sizeof(ta), false);
for i:=1 to n do
begin
if (ta[(a[i] - i + n) mod n] = false) then
ta[(a[i] - i + n) mod n]:=true
else
begin
Result:=false;
Exit;
end;
Result:=true;
end;
end;
begin
write('количество элементов перестановки: ');
readln(n);
fillchar(a, sizeof(a), 0);
count:=0;
{ ввод элементов начальной перестановки }
for i:=1 to n do a[i]:=i;
i:=n;
j:=i;
repeat
//output; { вывод текущей перестановки }
if testposition then
inc(count);
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;
writeln(count);
readln;
end.