• объединение множеств: A U B;
• пересечение множеств: A П B;
• разность (дополнение) двух множеств: A \ B.

Type SetType = Set Of BaseType;

Type SetType = Set Of 'A'..'D';
Var
  mySet: SetType;

Var otherSet: Set Of 0..7;

Const seLit: Set Of 'A'..'D' = [];

Var T: Set Of 1..3;

Примеры операций над множествами

1. Объединение множеств (C := A + B).
   Результат - множество, которое состоит из элементов, принадлежащих хотя бы одному из множеств.
   
   A = ['A', 'B'] и B = ['A', 'D']
   C = ['A', 'B', 'D']
   
   
2. Пересечение множеств (C := A * B)
   Результат - множество, состоящее из элементов, принадлежащих каждому из множеств
   
   A = ['A','D'] и B = ['A','B','C']
   C = ['A']
   
   
3. Разность множеств (C := A - B)
   Результат - множество, состоящее из тех элементов первого множества, которые не принадлежат второму
   
   A = ['A','B','C'] и B = ['A','B']
   C = ['C']

• тождественность (=): проверка на эквивалентность двух множеств
  ['A','B'] = ['A','C'] вернет False
• нетождественность (<>): проверка на неэквивалентность двух множеств
  ['A','B'] <> ['A','C'] вернет True
• содержится в (<=): проверка того, является ли левое множество подмножеством правого
  ['B'] <= ['B','C'] вернет True
• содержит (>=): проверка того, является ли правое множество подмножеством левого
  ['C','D'] >= ['A'] вернет False
• In: проверка принадлежности элемента базового типа, стоящего слева от знака операции, множеству, стоящему справа от знака операции. Результат выполнения этой операции - булевский.
  
  Операция проверки принадлежности элемента множеству часто используется вместо операций отношения, например:
  'A' In ['A', 'B'] вернет True,
  2 In [1, 3, 6] вернет False.

Type
  Number = 1 .. 36;
  Container = Set Of Number;
Var
  Selection: Container;
  Ball: Number;

uses Crt;
const
	n = 36;	{ общее количество шаров }
	m = 5;	{ количество шаров в выборке }
type
	Number = 1 .. 36;
	Container = set of Number;
var
	Selection: Container;
	i, Ball : Number;
begin
	ClrScr;
	Selection := [];
	randomize;
	
	for i := 1 to m do begin
		repeat
			Ball := Random(36) + 1;
		until not (Ball in Selection);
		Selection := Selection + [Ball];
		write(Ball: 3)
	end;
	readLn
end.

Решето Эратосфена

• Поместить все числа заданного диапазона в решето (Sieve).
• Изъять из решета наименьшее среди оставшихся в нем чисел и поместить его среди простых (Primes).
• Удалить из решета все числа, кратные данному.
• Если решето не пустое, то вернуться к пункту 2, иначе вычисления прекратить.

Var Sieve, Primes : Set Of 2 .. 255;

uses Crt;
const n = 255;
type
	number = 2 .. n;
var
	Sieve, Primes : set of number;
	i, n1, next: word;
begin
	ClrScr;
	Sieve := [2 .. n];
	Primes := [ ];
	next := 2;
	
	while Sieve <> [] do begin
		n1 := next;
		while n1 <= n do begin
			Sieve := Sieve - [n1];
			Inc(n1, next)
		end;
		Primes := Primes + [next];
		
		repeat
			Inc(next)
		until (next in Sieve) or (next > n)
	end;
	
	for i := 2 to 255 do
		if i in Primes then write(i:5);
	readln;
end.

Эмуляция множеств, способных работать с бОльшим числом элементов

const
	{ Константа, задающая максимальное число элементов в нашем новом типе }
	max_value = 10000;
	
	{ Это - число элементов, которое будет храниться в каждом множестве - элементе массива }
	every = 250;
	
	{
		Ну, а тут вычисляем, сколько элементов массива нужно для того, чтобы создать такой
		тип - заменитель множества, который сможет работать с max_value элементами
	}
	amount = max_value div every;
	
type
	{ Собственно, это и есть элемент массива множеств, базовое множество, состоящее из every элементов }
	T = set of 0 .. pred(every);

	{ А это - уже наше "псевдо"-множество, состоящее из amount настоящих множеств }
	TSet = array[0 .. pred(amount)] of T;

{
	Процедура Include - включает элемент, заданный вторым параметром
	в "псевдо"-множество, заданное первым параметром.

	В каждом I-ом элементе массива, представляющего наше "псевдо"-множество
	хранится только остаток от деления истинного числа на every, поскольку в любой момент
	по этому самому остатку и индексу содержащего его элемента массива можно однозначно
	идентифицировать истинное число ...
}
procedure include(var s: TSet; i: LongInt);
begin
	{
		Явное указание модуля System здесь нужно для того, чтобы показать компилятору,
		что мы не вызываем эту же процедуру рекурсивно, а вызываем именно процедуру Include
		для встроенного типа-множества, которая описана в модуле System.
	}
	system.include(s[i div every], i mod every)
end;

{
	Процедура Exclude - соответственно для удаления элемента I из "псевдо"-множества S
}
procedure exclude(var s: TSet; i: LongInt);
begin
	system.exclude(s[i div every], i mod every)
end;

{
	Поскольку мы для созданного нами типа не можем использовать In, как для встроенных
	в Паскаль множественных типов, придется написать свою функцию проверки, включен ли элемент
	I в наше "множество" S
}
function in_set(const s: TSet; i: LongInt): boolean;
begin
	{
		Для этого - просто вычисляем номер элемента массива, в котором I должен храниться,
		и проверяем, находится ли в этом элементе массива остаток от деления I на every. Если да, то
		считается, что I содержится в "множестве"
	}
	in_set := (i mod every) in s[i div every];
end;

{
	Еще одна дополнительная функция - проверка на пустоту, использующаяся вместо встроенной проверки
	на равенство "пустому множеству" для стандартных типов Set
}
function is_empty(const s: TSet): boolean;
var
	_result: boolean;
	i: LongInt;
begin
	_result := true;

	{
		Использованием цикла While я просто немного ускорил программу, т.к. теперь проход по
		циклу завершается немедленно после обнаружения того, что хотя бы одно из составляющих
		наш тип множеств НЕпустое
	}
	i := 0;
	while _result and (i < amount) do begin
		_result := _result and (s[i] = []);
		inc(i);
	end;
	
	is_empty := _result;
end;

{
	Печать множества - точно так же, как и для встроенных Set-ов, через проверку,
	входит ли очередной элемент во множество ...
}
procedure print_set(const s: TSet);
var
	i: LongInt;
begin
	for i := 0 to pred(max_value) do
		if in_set(s, i) then write(i:6);
	writeln;
end;

{
	А вот это и есть тот самый немного подправленный алгоритм "Решета Эратосфена"
}
const
	n = max_value - 1;
var
	sieve, primes: TSet;
	i, n1, next: LongInt;

begin
	{
		К сожалению, в нашем типе отсутствует механизм создавать множества так же просто,
		как это делалось со стандартными Set-ами, приходится заполнять "множество" поэлементно
	}
	for i := 2 to n do
		include(sieve, i);
	
	next := 2;
	while not is_empty(sieve) do begin
		n1 := next;
		while n1 <= n do begin
			exclude(sieve, n1);
			Inc(n1, next);
		end;
		include(primes, next);
		
		repeat
			inc(next);
		until (next > n) or in_set(sieve, next);
	end;
	print_set(primes);
end.

Примеры решения задач с использованием множеств

1. которыми обеспечены все институты;
2. которые имеет хотя бы один институт;
3. которых нет ни в одном институте.

type
	Продукт = (Хлеб, Масло, Молоко, Мясо, Рыба, Соль, Сыр, Колбаса, Сахар, Чай, Кофе);
	Ассортимент = set of Продукт;
	Магазины = array[1 .. 20] of Ассортимент;

1. множество продуктов, которые есть во всех магазинах;
2. множество продуктов, каждый из которых есть хотя бы в одном магазине;
3. множество продуктов, которых нет ни в одном магазине.

const n = 3;

type
	{ Продукты }
	product = (hleb, maslo, moloko, myaso, ryba, sol, syr, kolbasa, sahar, chai, cofe);
	{ Ассортимент }
	assort = set of product;
	{ Магазины }
	magazine = array[1 .. n] of assort;

const
{
	Задаем константу - название продукта. Этот массив будет всегда состоять
	из  такого же количества элементов, как и множество Product, и при внесении
	нового элемента во множество программа не откомпилируется до тех пор,
	пока изменения не будут внесены и в данный массив ...
}
	s: array[product] of string = (
		'hleb', 'maslo', 'moloko', 'myaso', 'ryba', 'sol', 'syr', 'kolbasa', 'sahar', 'chai', 'cofe'
	);

{
	I-ый элемент данной константы (массива множеств) описывает,
	какие продукты имеются в I-ом магазине
}
	stores: magazine = (
		[hleb, maslo, moloko, myaso, ryba],			{ 1 магазин }
		[hleb, maslo, ryba, sol, syr, kolbasa, sahar, chai],	{ 2 магазин }
		[ryba, sol, syr, kolbasa, sahar]			{ 3 магазин }
	);
	
{
	Процедура Наличие
}
procedure exists(arr: magazine; var a, b, c: assort);
var
	i: integer; j: product;
begin
	a := arr[1];	{
				Для правильной работы алгоритма множество "есть везде"
				должно в начале содержать ассортимент одного из магазинов
				(неважно, какого именно, я выбрал ассортимент первого)
			}
	b := [];		{
				А множество "есть где-нибудь" должно инициализироваться
				пустым множеством (не содержать никаких значений)
			}
	
{
	Для нахождения множества продуктов, которых нет ни в одном магазине,
	изначально нужно заполнить это множество всеми возможными для него
	значениями. Это может быть сделано либо так:
	
	C := [Low(Product) .. High(Product)];
	
	либо так:
}
	for j := low(product) to high(product) do
		c := c + [j];	
		
	for i := 1 to n do begin
		a := a * arr[i];	{ пересечение множеств: для поиска продуктов, которые "есть везде" }
		b := b + arr[i];	{ объединение множеств: для поиска продуктов, которые "есть где-то" }

		c := c - arr[i];	{
				разность полного комплекта товаров и текущего товара i-го магазина
				используется для поиска продуктов, которых "нет нигде"
				}
	end;
end;

{
	Процедура для распечатывания значений множества
}
procedure write_set(x: assort);
var j: product;
begin
	{
		перебираем все возможные значения, и выводим только названия тех,
		из них, которые есть в переданном в процедуру множестве
	}
	for j := low(product) to high(product) do
		if j in x then write(s[j], ' ');
	writeln
end;

var
  a, b, c: assort;

{
	Основная программа
}
begin
	exists(stores, a, b, c);		{ Вызываем процедуру проверки }
					{ и распечатываем полученные множества ... }
	write('A = '); write_set( a );
	write('B = '); write_set( b );
	write('C = '); write_set( c );
end.

Еще одна интересная задача на множества

type
  Имя = (Вася, Володя, Ира, Лида, Марина, Миша);
  Гости = set of Имя;
  Группа = array[Имя] of Гости;

type
	name = (vasya, volodya, ira, lida, marina, misha);
	guests = set of name;
	group = array[name] of guests;

const
	_group: group = (
		[volodya, misha],		{ Володя и Миша были в гостях у Васи (№1 в списке имен) }
		[vasya, lida, ira, misha], 	{ (у Володи) }
		[misha, vasya, marina],	{ (у Иры) }
		[misha, vasya, ira],	{ (у Лиды) }
		
		{
		Если допустить, что в гостях у Марины был Володя, то получится,
		что человека, побывавшего у всех в гостях, не существует... А вот если
		у Марины побывал Миша, то он и должен оказаться тем человеком,
		который был в гостях у всех остальных (действительно, тогда во всех
		элементах массива _group (кроме того, который соответствует самому
		Мише) присутствует имя misha)
		}
		[volodya],			{ (у Марины - вариант 1) }
		(*
		[misha],				{ (у Марины - вариант 2) }
		*)
		
		[vasya, ira]			{ (у Миши) }
	);
	
{
	Функция Везде, требуемая по условию.
	Вернет True в случае, если есть хотя бы один человек, побываыший в гостях у всех остальных
}
function vezde(gr: group): boolean;
var
	i, j: name;
	res: boolean;
	was: set of name;
 begin
	res := false;		{ Значение этой переменной вернется как результат функции }
	
	{
		Перебор всех студентов группы (I - очередной студент)
	}
	for i := low(name) to high(name) do begin
		{
		Множество Was будет содержать всех, у кого в гостях был I
		Естественно, в начале обработки каждого студента это множество требуется очистить
		}
		was := [];
		
		{ Теперь проходим по всем студентам, и ... }
		for j := low(name) to high(name) do
			{ ... если I был в гостях у J, то добавляем его к списку }
			if (i in gr[j]) then was := was + [j];
				
		{
		Если список тех, у кого в гостях побывал I (вместе с самим I)
		содержит _всех_ учащихся группы, это значит, что I побывал в
		гостях у всех остальных.
			
		Только в этом случае Res будет равно True
		}
		res := res or ((was + [i]) = [low(name) .. high(name)])
	end;
		
	{ Возвращаем результат }
	vezde := res
 end;

{ Основная программа }
begin
	{ Просто печатаем результат работы функции Vezde - True или False }
	writeln(vezde(_group))
end.

Ребусы

volvo + fiat = motor

...
for X := 0 to 9 do
	{
		Сначала проверяем, не находится ли текущее значение
		переменной X уже во множестве my_set, другими словами,
		не проверяется ли уже с этим же цифровым значением другая
		буква на каком-нибудь из предыдущих уровней вложенности
	}
	if not X in my_set then begin
		{
			Если мы здесь, то эта цифра еще не занята,
			поэтому вносим ее в my_set, ведь на более
			"глубоких" циклах она уже использоваться
			не должна
		}
		include(my_set, X); 
	
		... 	{ Здесь организуем вложенные циклы по тому же принципу }
	
		{
			Все, цифра проверена, значит ее можно "освободить",
			то есть извлечь из множества my_set
		}
		exclude(my_set, X);
	end;
...

{
  VOLVO+FIAT=MOTOR;
}
uses crt;

var
  v, o, l, f, i, a, t, m, r: 0 .. 9;

  dig : set of 0..9;
  sum, motor: longint;

begin
  clrscr;
  for v:=0 to 9 do begin
    include(dig,v);
    for o:=0 to 9 do if not (o in dig) then begin
      include(dig,o);
      for l:=0 to 9 do if not (l in dig) then begin
        include(dig,l);
        for f:=0 to 9 do if not (f in dig) then begin
          include(dig,f);
          for i:=0 to 9 do if not (i in dig) then begin
            include(dig,i);
            for a:=0 to 9 do if not (a in dig) then begin
              include(dig,a);
              for t:=0 to 9 do if not (t in dig) then begin
                include(dig,t);
                for m:= 0 to 9 do if not (m in dig) then begin
                  include(dig, m);
                  for r := 0 to 9 do if not (r in dig) then begin
                    include(dig, r);

    {
      Именно здесь происходит проверка, удовлетворяют ли
      значения переменных, полученные на этом шаге заданному ребусу
    }
    sum := v*10000 + (o+f)*1000 + (l+i)*100 + (v+t)*10 + (o+t);
    motor := m*10000+o*1000+t*100+o*10+r;

    {
      Если условие выполнено - напечатать ответ
    }
    if sum = motor then
      writeln(':', v,o,l,v,o,'+',f,i,a,t,'=', m,o,t,o,r);

                    exclude(dig, r)
                  end;
                  exclude(dig, m);
                end;
                exclude(dig,t);
              end;
              exclude(dig,a);
            end;
            exclude(dig,i);
          end;
          exclude(dig,f);
        end;
        exclude(dig,l);
      end;
      exclude(dig,o);
    end;
    exclude(dig,v);
  end;
end.

uses crt;

var
	dig: set of byte;
	
	first, second, res: string;
	T: string;

function check(s, what: string): longint;
var
	i: byte;
	n: longint;
begin
	n := 0;
	for i := 1 to length(s) do begin
		n := 10 * n;
		n := n + ( ord(what[ pos(s[i], T) ]) - 48 );
	end;
	check := n;
end;

procedure full(s: string);
var
	i: integer;
begin
	if length(s) = length(T) then begin
		if check(first, s) + check(second, s) = check(res, s) then
			writeln('found: ', check(first, s), '+', check(second, s), '=', check(res, s));
	end
	else
		for i := 0 to 9 do
			if not (i in dig) then begin
				include(dig, i);
				full(s + chr(48 + i));
				exclude(dig, i);
			end
end;

procedure fill_str(var s: string; what: string);
var
	i: byte;
begin
	for i := 1 to length(what) do
		if pos(what[i], s) = 0 then s := s + what[i];
end;

begin
	T := '';
	first := 'volvo'; second := 'fiat'; res := 'motor';
	fill_str(T, first); fill_str(T, second); fill_str(T, res);
	full('');
end.