Пример 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.