Версия для печати темы
Образовательный студенческий форум _ Информатика / Программирование _ Перестановки
Автор: Tri 29.9.2008, 6:27
Есть вот такая задача:
Цитата
Напишите программу для определения при разных значениях n числа перестановок PI=(pi 1,pi 2,…,pi n) на множестве {1,2,…n}, которые обладают тем свойством, что из pi i- i = pi j-j (mod n) следует i=j.
Я не совсем понимаю как реализовать условие, и что должно получиться.
Подскажите, пожалуйста, решение.
Вот такие наработки:
Код
{ программа генерации перестановок N элементного
множества в лексикографическом порядке }
Program perms;
var
i, j, h, n, k, x, y: 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;
i:=n;
j:=i;
repeat
//здесь пытаюсь проверить условие (не уверена, что оно вообще здесь должно быть)
x:= a[i]-i;
y:=a[j]-j mod n;
if (x=y) and (i=j) then
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.
Заранее большое спасибо!
Автор: creer 29.9.2008, 15:12
Хм, я тоже не очень понял условие, особенно необходимое свойство. Условие точно записано в таком виде без всяких дополнительных скобочек или индексов?
Автор: Tri 29.9.2008, 15:25
Вот исходник задания)
Прикрепленные файлы
doc.doc ( 19.5 килобайт )
Кол-во скачиваний: 20
Автор: creer 29.9.2008, 16:13
Перевожу на русский язык
.
У нас есть куча объектов какого-то класса pi, а именно числа. Чисел у нас ровно n, причем начинаются они с единицы. И мы хотим эти числа перемешать. Но кто-то захотел, чтобы при перемешивании (всеми способами) мы кое-что посчитали, а именно, сколько же всего возможно комбинаций при данном числе объектов, когда все значения выражения "текущее положение числа минус само число" будут различны, причем по модулю n.
У кого есть возражения?
Автор: Tri 29.9.2008, 16:45
Честно говоря, не очень поняла:)
Значения выражения должны быть, наверное, одинаковыми, раз знак равенства? И не совсем понимаю как это запрограммировать, сравнение загнать в цикл, в котором менять i и j?
Автор: Tri 29.9.2008, 17:37
Спасибо большое за идею, попробую.
p.s.Нет, сдавать, к счастью, не завтра:)
Автор: creer 29.9.2008, 18:25
Попробуйте 
Если будет время, то завтра напишу свой вариантик
Автор: creer 30.9.2008, 14:47
Я добавил одну функцию в программу, которая для каждой позиции проверяет то, что я описывал выше. Посмотрите 
Код
{ программа генерации перестановок 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.
Автор: malk 1.10.2008, 8:19
Код
procedure TForm1.Button1Click(Sender: TObject);
var s,n:integer;
type sm=set of 0..99;
procedure rek(b,c:sm; i:integer);
var x:integer;
begin
for x:=0 to n-1 do
if (x in b)and(((x-i+n)mod n)in c) then
begin
if i<n-1 then rek(b-[x],c-[(x-i+n)mod n],i+1) else s:=s+1;
end;
end;
begin
s:=0;
n:=strtoint(edit1.Text);
rek([0..n-1],[0..n-1],0);
label2.Caption:=inttostr(s);
end;
Для четных n искомое будет всегда равно 0.
Русская версия Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)