Множества
   
Эмуляция множеств, способных работать с бОльшим числом элементов Решето Эратосфена: числа до 256 / бОльший диапазон
  Примеры решения задач с использованием множеств
  Еще одна интересная задача на множества / Ребусы
   
В математике под множеством понимается некоторый неупорядоченный набор элементов. Например, множество целых чисел или множество букв латинского алфавита. К множествам применимы следующие операции: Например:
{1, 2} U {3, 2, 4} = {1, 2, 3, 4}
{1, 2} П {3, 2, 4} = {2}
{1, 2} \ {3, 2, 4} = {1}

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

Множественный тип описывается с помощью служебных слов Set Of, например:
Type SetType = Set Of BaseType;
где SetType - множественный тип, ВaseType - базовый тип.

Пример описания переменной множественного типа:
Type SetType = Set Of 'A'..'D';
Var
  mySet: SetType;
Принадлежность переменных к множественному типу может быть определена прямо в разделе описания переменных:
Var otherSet: Set Of 0..7;
Константы множественного типа записываются в виде заключенной в квадратные скобки последовательности элементов или интервалов базового типа, разделенных запятыми, например:
['A', 'C']    [0, 2, 7]    [3, 7, 11..14]

Константа вида [ ] означает пустое подмножество.

Количество базовых элементов не должно превышать 256.

Инициализация величин множественного типа может производиться с помощью типизированных констант:
Const seLit: Set Of 'A'..'D' = [];
Порядок перечисления элементов базового типа в константах безразличен.

Множество включает в себя набор элементов базового типа, все подмножества данного множества, а также пустое подмножество. Так, переменная Т множественного типа
Var T: Set Of 1..3;
может принимать восемь различных значений:
[ ] [1] [2] [3] [1,2] [1,3] [2,3] [1,2,3]

К переменным и константам множественного типа применимы операции присваивания(:=), объединения(+), пересечения(*) и вычитания(-). Результат выполнения этих операций есть величина множественного типа.

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

Пусть заданы 3 множества с одинаковым базовым типом: A, B и C...
  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']
К множественным величинам применимы операции: В качестве примера работы с множествами можно рассмотреть моделирование "лототрона (5 из 36)" т.е. случайную выборку 5 шаров из контейнера, содержащего 36 шаров, пронумерованных от единицы до 36. Множество шаров в этом случае удобно представить описаниями вида:
Type
  Number = 1 .. 36;
  Container = Set Of Number;
Var
  Selection: Container;
  Ball: Number;
Решение задачи сводится к генерации случайного числа (номера шара) в интервале от 1 до 36 с проверкой условия принадлежности очередного шара множеству ранее выбранных, причем на первом шаге это множество пустое. Выбору шара соответствует вывод его номера на экран. Для генерации случайных чисел используется стандартная функция Random(n).
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.
Структура данных типа set оказывается безусловно полезной в случаях, когда задача легко формулируется в терминах множеств и, кроме того, позволяет существенно упростить программирование “длинных” условных выражений, связанных с проверкой на принадлежность. К последним, например, относятся, задачи анализа текстов и, в частности задача сканирования текстов программ с целью выделения лексем и других конструкций языка при трансляции.

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

В качестве еще одного примера использования типа set рассмотрим задачу поиска простых чисел в диапазоне 2, ... , 255.

Из-за простоты решения (не используются операции умножения и деления) в основу поиска положен метод, известный под названием "решето Эратосфена". Тогда алгоритм поиска простых чисел сводится к следующему. Решето и множество простых чисел можно описать как:
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.

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

Как легко заметить, вышеприведенный алгоритм имеет один существенный недостаток: поскольку максимальное число элементов множества = 256, с помощью такого "решета" нельзя искать простые числа большие, чем 255.

Однако, путем несложных манипуляций можно добиться того, что программа будет работать практически с любым интервалом чисел... Все, что потребуется для этого - написать свои процедуры Include/Exclude (и пользоваться в программе именно ими, а не операторами "+" и "-"), и функцию In, а само множество - заменить на массив множеств:

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.

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

Пример задачи:

Задано множество вычислительных машин, которыми может быть обеспечен институт:
IBM-386, IBM-486, Pentium, Macintosh, Apple, Acer.

Известен набор машин, имеющихся в каждом институте. Количество институтов = N.

Требуется:
Построить и распечатать множество, включающее в себя вычислительные машины:
  1. которыми обеспечены все институты;
  2. которые имеет хотя бы один институт;
  3. которых нет ни в одном институте.

(***** ***** *****)

Или вот такой вариант этой же задачи (задания сводятся к одному и тому же, поэтому решение приведено только для второго варианта)

type
	Продукт = (Хлеб, Масло, Молоко, Мясо, Рыба, Соль, Сыр, Колбаса, Сахар, Чай, Кофе);
	Ассортимент = set of Продукт;
	Магазины = array[1 .. 20] of Ассортимент;
Требуется:
Описать процедуру Наличие(Маг, А, В, С), которая по информации из массива Маг типа Магазины (Магi – это множество продуктов, имеющихся в i-ом магазине) присваивает параметрам А, В и С типа Ассортимент следующие значения:
  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 Гости;
Требуется:
Описать логическую функцию Везде(Гр) определяющую, есть ли в группе Гр хотя бы один человек, побывавший в гостях у всех остальных из Группы...

(Гр[X] - множество людей, побывавших в гостях у человека с именем X; X не принадлежит Гр[X])

Решение задачи:
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
потребуется 9 вложенных циклов, так как если записать все слова в одну строку и удалить дубликаты, получим: "volfiatmr", то есть 9 разных букв. А дальше делаем следующее. Организуем 9 вложенных циклов по 9 переменным, причем на каждом уровне вложенности сделаем вот такие действия:
...
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" итеративно:
{
  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.
Другие ребусы (на форуме "Все о Паскале"): "барбос + бобик = собаки": Множества: загадка-ребус
"радар = (р+а+д)4": Алгоритм решения ребуса