Хочу получить размещения из 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
3.11.2007 0:55
У тебя в программе происходит выход за границы массива... Перекомпилируй программу с ключом {$R+} и ты увидишь, где именно происходит ошибка... А это значит, что результатам работы программы (после такого сбоя) доверять просто нельзя...
18192123
3.11.2007 1:20
Цитата(volvo @ 2.11.2007 20:55)
У тебя в программе происходит выход за границы массива... Перекомпилируй программу с ключом {$R+} и ты увидишь, где именно происходит ошибка... А это значит, что результатам работы программы (после такого сбоя) доверять просто нельзя...
программа вылетает на процедуре output1.....получается, что-то лишнее добавляется в цикле для получения перестановок... но в чём причина конкретно, я не пойму.....
volvo
3.11.2007 1:30
Цитата
но в чём причина конкретно, я не пойму.....
Смотри:
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
3.11.2007 1:52
Цитата(volvo @ 2.11.2007 21:30)
а очередной элемент razm1[i] содержит 0...
да, действительно....и тогда получается размещение с 0 (если компилировать без режима {$R+}). но дело в том, что это и является лишним при исходном множестве, например, 1 2 3, если выводить размещения по 2. индексация с 0 поможет как раз это исправить?
volvo
3.11.2007 6:23
Смотри, я не сторонник выдумывания новых алгоритмов... Есть алгоритм нахождения всех сочетаний из 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 ]]])
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.