Помощь - Поиск - Пользователи - Календарь
Полная версия: Размещения из n по m
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
18192123
Хочу получить размещения из n элементов по m элементов. Для этого для каждого возможного сочетания из n по m нахожу перестановки по m. Проблема в том, что размещений получается больше чем нужно!! Объясните пожалуста, чего я не предусмотрела!



uses crt;

type
mas=array[0..100] of integer;
mas1=array[1..100] of integer;

Var
razm,razm1 : mas;
s : mas1;
m,n,k,f,kol : integer;
i,j : byte;

procedure output;
var i: integer;
begin
for i:=1 to m do write(s[razm[i]]);
end;

procedure output1;
var i: integer;
begin
for i:=1 to m do write(s[razm1[i]]);
end;

Begin
clrscr;
writeln ('Naidem razmeshenia iz n elementov no m');
writeln ('Enter n and m');
readln (n,m);
writeln ('Vvedite mn-vo razmerom n');
for i := 1 to n do
readln (s[i]);
writeln ('Mn-vo razmerom n:'); writeln;
for i := 1 to n do
write ( s[i]:5);
readln;
clrscr;
for i:=1 to m do razm[i]:=i;
for i:=1 to m do razm1[i]:=i;
kol := 0;
while i <> 0 do
begin
output; write(' '); kol := kol + 1;
for i := 1 to m do razm1[i] := razm[i];
repeat
i:=m;
while razm1[i-1]>razm1[i] do
i := i - 1;
j:=i-1;
f:=razm1[j];
while razm1[i+1]>f do
i := i + 1;
razm1[j]:=razm1[i];
razm1[i]:=f;
i:=j+1;
k:=m;
while i<k do
begin
f:=razm1[i];
razm1[i]:=razm1[k];
razm1[k]:=f;
i := i + 1;
k := k - 1
end;
output1; write(' '); kol := kol + 1;
until j=0;
i :=m;
while razm[i]=n-m+i do
i := i-1;
razm[i] := razm[i] + 1;
for j := i+1 to m do
razm[j] := razm[j-1] + 1;
end;
writeln;
writeln('Kol-vo razmeshenii:', kol);
readkey;
End.





volvo
У тебя в программе происходит выход за границы массива... Перекомпилируй программу с ключом {$R+} и ты увидишь, где именно происходит ошибка... А это значит, что результатам работы программы (после такого сбоя) доверять просто нельзя...
18192123
Цитата(volvo @ 2.11.2007 20:55) *

У тебя в программе происходит выход за границы массива... Перекомпилируй программу с ключом {$R+} и ты увидишь, где именно происходит ошибка... А это значит, что результатам работы программы (после такого сбоя) доверять просто нельзя...


программа вылетает на процедуре output1.....получается, что-то лишнее добавляется в цикле для получения перестановок... но в чём причина конкретно, я не пойму.....
volvo
Цитата
но в чём причина конкретно, я не пойму.....
Смотри:

procedure output1;
var i: integer;
begin
for i:=1 to m do write(s[razm1[i]]); { <--- проблема - здесь !!! }
end;


Что тут происходит? Массив S индексируется от единицы (поскольку это тип mas1), а очередной элемент razm1[i] содержит 0... Обращение по нулевому индексу к S - это ошибка...

По-моему, тебе надо просто перевести всю программу на нормальную индексацию, с 0 а не с единицы, чтобы не путаться.
18192123
Цитата(volvo @ 2.11.2007 21:30) *

а очередной элемент razm1[i] содержит 0...


да, действительно....и тогда получается размещение с 0 (если компилировать без режима {$R+}). но дело в том, что это и является лишним при исходном множестве, например, 1 2 3, если выводить размещения по 2. индексация с 0 поможет как раз это исправить?
volvo
Смотри, я не сторонник выдумывания новых алгоритмов... Есть алгоритм нахождения всех сочетаний из N по M (то, что у нас в FAQ-е называется Combination), и есть алгоритм нахождения всех перестановок (Permutations). Если их объединить, то получится алгоритм нахождения размещений:

const
max_n = 100;
type
arrType = array[1 .. max_n] of integer;

var
s: arrType; { <-- Это те значения, размещения которых будем выводить }
mas: arrType; { <-- Это - массив для хранения сочетаний }

N, M: Longint;
I, J: Longint;


{
для каждого из сочетаний вызываем эту процедуру обработки - и
внутри нее для конкретного сочетания находим все перестановки
}
procedure ProcessCombination(const values: arrType);

var
mas: arrType; { <-- Это - массив для перестановок }
i, j, k: integer;

procedure WritePermutation;
var i: Longint;
begin
for i := 1 to M do write(s[values[mas[i]]], ' '); { <--- Вот она - основная мысль !!! }
writeln;
end;

procedure swap(i, k: longint);
var X: byte;
begin
X := mas[i]; mas[i] := mas[k]; mas[k] := X;
end;

begin

fillchar(mas, sizeof(mas), 0);
for i := 1 to m do mas[i] := i;

while true do begin
WritePermutation;
i := M;
while (i > 0) and (mas[i] >= mas[i + 1]) do dec(I);

if I = 0 then break;

for J := I + 1 to M do
if mas[J] > mas[I] then k := J;
swap(I, k);
inc(I);
J := M;

while I < J do begin
swap(I, J); inc(I); dec(J);
end;
end;

end;



begin

write('n = '); readln(n);
write('m = '); readln(m);
writeln('enter the set of N items:');
for i := 1 to n do readln(s[i]);

for i := 1 to m do mas[i] := i;
while true do begin
ProcessCombination(mas);
i := M;
while (i > 0) and (mas[i] = N - M + i) do dec(i);

if i = 0 then break;
inc(mas[i]);
for j := i + 1 to M do mas[j] := mas[j - 1] + 1;
end;

end.

(в чем была основная мысль? В двойной индексации... Не просто s[mas[ i ]], а еще один уровень - через сочетания: s[values[mas[ i ]]])
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.