IPB
ЛогинПароль:

> Внимание! Действует предмодерация

Подраздел FAQ (ЧАВО, ЧАстые ВОпросы) предназначен для размещения готовых рабочих программ, реализаций алгоритмов. Это нечто вроде справочника, он наполнялся в течение 2000х годов. Ваши вопросы, особенно просьбы решить задачу, не пройдут предмодерацию. Те, кто наполнял раздел, уже не заходят на форум, а с теми, кто на форуме сейчас, лучше начинать общение в других разделах. В частности, решение задач — здесь.

 
 Ответить  Открыть новую тему 
> Комбинаторика
сообщение
Сообщение #1


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


Код
Function Accomodations(N,K:Longint):Longint;
var i,Result:longint;
begin
  Result:=1;
  For i:=n downto (n-k+1) do result:=result*i;
  Accomodations:=result
end;

Function Transpositions(N:longint):Longint;
begin
  Transpositions:=Accomodations(N,N)
end;

Function Combination(N,K:Longint):Longint;
var numerator,denominator,i:longint;
begin
  numerator:=1; denominator:=1;
  for i:=N downto (N-K+1) do numerator:=numerator*i;
  for i:=1 to K do denominator:=denominator*i;
  Combination:=numerator div denominator
end;

procedure BinomialTheorum(N:longint);
var K,T,SA,SB:Longint;
begin
  writeln;
  for K:=0 to n do
  begin
    SA:=n-k; SB:=k;
    T:=Combination(N,K);
    If T>1 then write(T);
    If SA=1 then write('A');
    If SA>1 then write('A^',SA);
    If SB=1 then write('B');
    If SB>1 then write('B^',SB);
    If k<>n then write(' + ');
  end;
  writeln
end;

begin
BinomialTheorum(3);
writeln(Combination(14,7));
writeln(Accomodations(14,5));
writeln(Transpositions(3));
end.

Function Accomodations(N,K:Longint):Longint;
Вычисление размещений из N по К.
(число размещений из N по K есть число К-элементных упорядоченных подмножеств множества, содержащего N элементов.)
Function Transpositions(N:longint):Longint;
Вычисление числа перестановок. (A из n по n)
Function Combination(N,K:Longint):Longint;
Вычисление сочетаний из N по K. (k элементные подмножества множества, содержащего N элементов.)
procedure BinomialTheorum(N:longint);
Выводит на экран разложение (a+b)^n. по формуле Ньютона.
Входной паарметр - N.


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






При решении задач на практике часто приходится выбирать из некоторого множества объектов какие-либо подмножества, обладающие заданными свойствами, размещать элементы в определенном порядке и т.д. Такие задачи называются комбинаторными. Классическими задачами комбинаторики являются задачи о перестановках, выборках, сочетаниях.

Перестановки
Перестановки описывают, сколькими способами можно расставить N различных предметов на N различных позиций.

Число перестановок принято обозначать Pn. N различных элементов можно расставить на N различных мест N! способами. Следовательно, Pn = N! = 1*2*… *(N-1)*N.

Также важной задачей является не только подсчет количества перестановок, но и их генерация, при этом больший интерес представляет генерация перестановок в определенном порядке, например, лексикографическом (отсортированном по возрастанию).

Рассмотрим задачу генерации всех перестановок N-элементного множества в лексикографическом порядке. В качестве примера рассмотрим перестановку для N=3

Цитата
1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1

Алгоритм генерации следующей перестановки таков: начиная с конца перестановки находим такой элемент a[i]: a[i-1]<a[i]; затем в конце перестановки находим элемент a[j] больший чем a[i-1]; далее меняем местами элементы перестановки a[i-1] и a[j]; и оставшуюся конечную часть перестановки упорядочиваем в порядке возрастания.

{ программа генерации перестановок N элементного 
множества в лексикографическом порядке }

Program perms;
var
i, j, h, n, k: 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;

repeat
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.


Для получения всех n! перестановок необходимо, чтобы начальная перестановка образовывала возрастающую последовательность (то есть была первой в лексикографическом порядке). Следует прокомментировать следующие два момента: почему условием окончания работы программы является выполнение равенства j=0 и почему для упорядочивания хвоста перестановки используется простой цикл без всяких сравнений.
  1. Следуя логике алгоритма, последняя перестановка представляет собой убывающую последовательность. Следовательно, позиция скачка будет равна 1 и соответственно j=0. Ни в каком другом случае равенство j=0 не выполняется, так как тогда перестановка не будет убывающей последовательностью, то есть не является последней.
  2. Об упорядочивании хвоста следует сказать только одно: хвост всегда представляет убывающую последовательность, поэтому требуется его только инвертировать.

Сочетания
Задачи о сочетаниях решают вопрос о том, сколькими способами можно выбрать M элементов из заданного N элементного множества и генерации всех возможных выборок. Число выборок вычисляется следующей формулой С=n!/(m!(n - m)!).

Рассмотрим задачу о генерации сочетаний в лексикографическом порядке.
Для примера рассмотрим начальные данные N=6 и M=4. Тогда число сочетаний равно 15. Начальное сочетание образует последовательность 1, 2, .. m, а последнее n-m+1, … , n.

Цитата
1234 1256 2345
1235 1345 2346
1236 1346 2356
1245 1356 2456
1246 1456 3456

Переход к следующему сочетанию осуществляется по следующему правилу: требуется просмотреть текущее сочетание с конца и найти элемент, который можно увеличить. То есть такой элемент что a[i] <> n-k+i. Далее увеличиваем этот элемент на 1, а оставшуюся часть сочетания заполняем числами натурального ряда большими измененного элемента в порядке их следования.

program sochets;
var
i, j, n, m: integer;
a: array[0 .. 100] of integer;

{ процедура вывода текущего сочетания }
procedure use;
var i: integer;
begin
writeln;
for i:=1 to m do write(a[i]:3)
end;

begin
write('ввод N и M: '); read(n, m);

{ формирование первого сочетания }
for i:=0 to m do a[i]:=i;

repeat
use;
i:=m;
while a[i]=n-m+i do dec(i); { поиск элемента для изменения }
inc(a[i]);
for j:=i+1 to m do a[j]:=a[j-1]+1; { изменение правой части сочетания }
until i=0;
end.

Рекурсивный алгоритм генерации сочетаний (с повторениями):
const
n = 3;
k = 2;

procedure s_pov(s: string);
var i: integer;
begin
if length(s) = n then begin
for i := 1 to length(s) do
write(s[i] + ' ');
writeln;
end
else
for i := k downto 1 do
s_pov(s+chr(ord('0') + i));
end;

begin
s_pov('');
end.


Подмножества
Для генерации всех подмножеств N-элементного множества: введем массив b[1..n] такой, что если b[i]=1 то i-й элемент входит в подмножество и если b[i]=0, то иначе. Тогда пустому подмножеству будет соответствовать набор из 0, а n-элементному подмножеству набор из 1. Поэтому здесь явно заметна связь с двоичным представление чисел в интервале 0 … 2N–1.

Будем находить двоичное представление числа и формировать характеристические вектора подмножеств. Изначально положим b[i]=0 для всех I, что соответствует пустому подмножеству. Введем массив a[1..n] соответствующий двоичному представлению числа. Будем моделировать операцию сложения этого числа с 1. Для этого просмотрим число справа налево, заменяя единичные биты на нулевые до тех пор, пока не найдем нулевой бит, который заменим на 1.

program subsets;
var
i, n: integer;
a, b: array[0..100] of integer;

procedure output;
var i : integer;
begin
{ вывод двоичного числа }
for i:=1 to n do write(' ',a[i]);
write(' ');

{ вывод характеристического вектора подмножества }
for i:=1 to n do write(' ',b[i]);
write(' ');

{ вывод подмножества }
for i:=1 to n do
if(b[i]=1) then write(' ',i);
end;

begin
readln(n);
fillchar(a,sizeof(a),0);
fillchar(b,sizeof(b),0);
repeat
output;
i:=n;
while a[i]=1 do begin
a[i]:=0; dec(i); { перенос в следующий разряд }
end;
a[i]:=1;
b[i]:=1-b[i] { b[i] = (1+b[i]) mod 2 }
until i=0;
end.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Бывалый
***

Группа: Пользователи
Сообщений: 180
Пол: Мужской
Реальное имя: Юра

Репутация: -  1  +


Генерация разбиений n-элементного множества на k блоков.
Разбиение множества (1,…,n) мы будем представлять с помощью последовательности блоков, упорядоченной по возрастанию самого маленького элемента в блоке. Например (для множества из 4 элементов, разбиение на три подмножества):
( 1 2 ) ( 3 ) ( 4 )
( 1 4 ) ( 2 ) ( 3 )
( 1 ) ( 2 4 ) ( 3 )
( 1 ) ( 2 ) ( 3 4 )
( 1 ) ( 2 3 ) ( 4 )
( 1 3 ) ( 2 ) ( 4 ) (в каждом блоке элементы упорядочены по возрастанию)
Этот наименьшей элемент блока мы будем называть номером блока. Надо заметить, что номера соседних блоков совсем не обязательно являются соседними натуральными числами, например для блоков: ( 1 2 ) ( 3 ) ( 4 ), номера каждого блока будут: 1, 3 и 4.
В этом алгоритме мы будем использовать переменные Prev[i], Next[i], 1<=i<=n, содержащие соответственно номер предыдущего и номер следующего блока, для блока с номером i. (Next[i]=0, если блок с номером i является последним блоком разбиения) Например для разбиения ( 1 2 ) ( 3 ) ( 4 ) эти переменные будут выглядеть следующим образом: Prev[0,1,3], Next[3,4,0].
Для каждого элемента I, 1<=i<=n, номер блока, содержащего элемент i, будет храниться в переменной Blok[i], например для разбиения ( 1 2 ) ( 3 ) ( 4 ) – Blok[1,1,2,3], а для разбиения ( 1 3 ) ( 2 ) ( 4 ) – Blok[1,2,1,3].
Направление, в котором «движется» элемент I, будет находиться в переменной Forw[i] (Forw[i]==1, если I, движется вперед, Forw[i]==0, если I, движется назад).


program razbien;
uses crt;
const NN=100;
type arr=array[1..NN] of integer;

procedure vivod(a,b:arr;n,kol:integer);
var
i,k,t:integer;
begin
for k:=1 to n-1 do
for i:=1 to n-k do
if(b[i]>b[i+1]) then
begin
t:=b[i];
b[i]:=b[i+1];
b[i+1]:=t;
t:=a[i];
a[i]:=a[i+1];
a[i+1]:=t;
end;
t:=1;
for i:=2 to n do
if b[i]<>b[i-1] then inc(t);

if(kol=t) then
begin
write('(',a[1]);
for i:=2 to n do
if b[i]<>b[i-1] then
write(') (',a[i])
else
write(' ',a[i]);
writeln(')');
end;
end;

{функциия расчета числа Стирлинга второго рода - число неупорядоченных разбиений
n-элементного множества на k непустых подмножеств }
function Stirling2rec(n,k:integer):longint;
begin
if n=k then
Stirling2rec:=1
else
if(k=0) then Stirling2rec:=0
else Stirling2rec:=Stirling2rec(n-1,k-1)+k*Stirling2rec(n-1,k);
end;

}
var
a,
Prev, {номер предыдущего блока}
Next, {номер следующего блока: Next[I]=0, если блок I является последним блоком разбиения}
Blok:arr; {номер текущего блока}
j,i, {минимальный элемент текущего блока}
n,k,kol:integer;
Forw:array[1..NN] of boolean; {направление в котором движется элемент I, =true, если движется вперёд}


begin
clrscr;
write('Введите количество элементов множества: ');
readln(n);
write('Введите количество подмножеств для разбиения множества: ');
readln(kol);
{ s:=Stirling2rec(n,k);
writeln(s); }
{инициализация исходного множества}
for i:=1 to n do
begin
a[i]:=i;
Blok[i]:=1;
Forw[i]:=true;
end;
Next[1]:=0;
{вывести разбиение}
vivod(a,Blok,n,kol);
j:=n; {j=активный элемент}
while j>1 do
begin
k:=Blok[j];
if Forw[j] then {j движется вперёд}
begin
if Next[k]=0 then {k есть последний блок}
begin
Next[k]:=j;
Prev[j]:=k;
Next[j]:=0;
end;
if Next[k]>j then {j образует новый блок}
begin
Prev[j]:=k;
Next[j]:=Next[k];
Prev[Next[j]]:=j;
Next[k]:=j;
end;
Blok[j]:=Next[k];
end
else {j движется назад}
begin
Blok[j]:=Prev[k];
if k=j then {j образует одноэлементный блок}
if Next[k]=0 then
Next[Prev[k]]:=0
else
begin
Next[Prev[k]]:=Next[k];
Prev[Next[k]]:=Prev[k];
end
end;
{выписать разбиение}
vivod(a,Blok,n,kol);
j:=n;
while (j>1) and
( (Forw[j] and (Blok[j]=j)) or (not Forw[j] and (Blok[j]=1)) ) do
begin
Forw[j]:=not Forw[j];
j:=j-1;
end;
end;
readkey;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 28.04.2017 18:59
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"