Пример 2

Составить программу выделения из множества целых чисел от 1до 30 следующих множеств:

- множества чисел кратных 2;

- множества чисел кратных 3;

- множества чисел кратных 6;

- множества чисел кратных 2 или 3.

Program Mnogestva_2;

Const n = 30;

Type mn = Set of 1..n;

Var n2, n3, n6, n23 : mn; {n2 – множество чисел, кратных 2 и т.д.}

k:integer;

Procedure Print(m:mn);

Var i:integer;

Begin

For i:=1 To n Do If i In m Then Write( I : 3 ); Writeln;

End;

Begin

n2 := []; n3 := []; {начальное значение множеств}

For k:= 1 To n Do { формирование n2 и n3}

Begin

{если число делится на 2, то заносим его в n2}

If k Mod 2 = 0 Then n2 := n2 + [k];

{если число делится на 3, то заносим его в n3}

If k mod 3 = 0 Then n3:=n3 + [k];

End;

{числа, кратные 6, - это те, которые кратны и 2, и 3, поэтому это пересечение двух первых множеств, а числа кратные 2 или 3, - это объединение этих же множеств}

n6: = n2 * n3; n23 := n2 + n3;

{вывод множеств}

Writeln('числа, кратные 2 ');

Print(n2);

Writeln('числа, кратные 3 ');

Print(n3);

Writeln('числа, кратные 6 ');

Print(n6);

Writeln('числа, кратные 2 или 3 ');

Print(n23);

End.

Пример 3

Если взять то общее, что есть у боба с ложкой, добавить кота и поместить в тепло, то получится муравей. Так ли это? Состоит ли муравей из кота?

Program Mnog3;

Var y1, y2, y3, y4, x : Set Of Char;

S : Char;

Begin

y1:=['b', 'o', 'b'];

y2:=['l', 'o', 'g', 'k', 'a'];

y3:=['k', 'o', 't'];

y4:=['t', 'e', 'p', 'l', 'o'];

x:=(y1 * y2) + y3 - y4;

Write(' множество x ');

For s:='a' To 'z' Do

If s In x Then Write(s);

Writeln; {проверка: состоит ли муравей из кота}

If y3<=x Then Write('yes')

Else Write('No');

Readln;

End.

Пример 3

Дано натуральное число п. Составить программу вывода цифр, не входящих в десятичную запись числа n (в порядке возрас­тания).

Program mnog;

Type Mn=Set Of 0..9;

Var s : Mn ;

n,i:Integer;

Begin

WriteLn('Введите число n'); ReadLn (n) ;

s:=[];

While n<>0 Do

Begin

i:=n Mod 10;{* Исключаем цифру. *}

n:=n Div 10;

If not (I in s) Then s:=s + [I];

End;

For i:=0 to 9 Do

If not (I in s) Then Write(i:2) ; WriteLn;

End.

Измените программу так, чтобы находились общие цифры в записи n чисел.

Пример 4. «Решето Эратосфена». Найти простые числа в интервале от 2 до п.

var m:set of Byte;

i,k,n:integer;

begin

writeln('Enter interval (do 255)');

readln(n);

m:=[2..n];

for k:=2 to n div 2 do

for i:=2 to n do

if (i mod k = 0) and (i<>k) then m:=m-[i];

for i:=1 to n do

if i in m then write(i:5);

readln;

end.

Напомним, что простым числом называется число, не име­ющее другі-х делителей, кроме

единицы и самого себя.

Измените программу так, чтобы находилась первая 1000 простых чисел.

Откажемся от этого простого решения решения. Применим идею ”Решета Эратосфена», ибо наша цель — изучение множественного типа данных. Суть метода — считаем все числа интервала про­стыми, а затем «вычеркиваем» те, которые не удовлетворяю требованию простоты. Как осуществляется вычеркивание. И ходим очередное невычеркнутое число, оно простое, и удалив все числа, кратные ему. После такого «просеивания» в исход ном множестве останутся только простые числа.

Program Myl8_2m;

Const n=255;

Type Mn=Set Of 0. .n;

Var Sim:Mn;

і,j:Integer;

Begin

Sim:=[2. .n] ; j:=2;

While j <=n Div 2 Do

Begin

If j In Sim Then

Begin{*Поиск очередного простого числа.*} і : =j +j ;

While i<=n Do

Begin

Sim:=Sim-[i];Inc(i,j);

End;{*Вычеркивание. *}

End;

Inc(j) ;

End;

For i:=2 To n Do If і In Sim Then Write (i: 4);

{*Вывод оставшихся после вычеркивания чисел, они простые. *} ReadLn;

End.

Поиск простых чисел из интервала, большего, чем 0.. 255, «упирается» в ограничение множественного типа данных — не более 256 значений базового типа. Уйдем от этого ограничения путем ввода массива, элементами которого являются множест­ва. Но прежде, чем рассмотрим решение, небольшой фрагмент:

{$R+}

Program Myl8_2mm;

Var Mn: Set Of 1. .255;

a:Word;

Begin

Mn:=[l..255]; a:=258;

If a In Mn Then WriteLn ('Yes')

Else WriteLn ('No') ; ReadLn;

End.

После запуска программы видим знакомую до боли ошибку — Error 202: Range check error.

Значение переменной а выходит за допустимый диапазон значений. Учтем этот факт при

описании очередной версии программы.

Program Му18_2ттт;

Uses Crt;

Const m=255;n=1000 ;

Type Mn=Set Of 1. .m; OMyArray=Array [0 . . (n Div m) ] Of Mn;

Var Sim:Mn; A : OMyArray ; і , j ,k : Integer; Begin

ClrScr;

k:=(n Div m) ;

For i:=0 To k Do A [i ] : = [1 . . m] ;

j:=2;

While j<=n Div 2 Do

Begin

If (j Mod m) In A[j Div m] Then

Begin

i:=j+j

While i<=n Do

Begin

A[i Div m] :=A[i Div m]-[i Mod m] ;Inc (i,j):

End;

End;

Inc(j) ;

End;

For i:=2 To n Do If (i Mod m) In A[i Div m] Then Write (i, ' ' ) ;

ReadLn ;

End.

3. Решение ребусов мы рассматривали на предыдущих заняти­ях. С использованием

множественного типа данных програм­мный код получается более компактным.

Подсчитаем коли­чество решений ребуса МУХА+МУХА=СЛОН.

Program Myl 8_ 3 ;

Type Mn=Set Of 0. .9;

Var i, j , cnt : Integer; Sm,Se:Mn;

Procedure Change (t : Integer ; Var 5:Мп);{*Из цифр числа формируем множество .*}

Begin

S: = []; While t<>0 Do

Begin

S:=S+[t Mod 10] ;t:=t Div 10;

End;

End;

Function Qw(S:Mn):Integer;{^Подсчитываем количество элементов в множестве.*}

Var і,ent:Integer,•

Begin

cnt:=0;

For i:=0 To 9 Do

If і In S Then Inc(cnt) ; Qw:=cn t;

End;

Begin

cnt:=0;{* Счетчик числа решений.*}

For і: =1000 To 4999 Do

Begin

{*'Результат -четырехзначное число, поэтому слагаемое не превышает 4999.*}

Change (i , Sm) ;

If Qw(Sm)=4 Then

Begin

{ *Если все цифры числа различны, то выполняем дальнейшие вычисления. *}

j:=2*i; Change (j , Se) ;

If (Sm*Se=[]) And (Qw(Se)=4) Then Inc(cnt);

{*Числа состоят из различных цифр, и все цифры результата различны. *}

End;

End;

WriteLn (cnt);

End.