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


Понравилась статья? Добавь ее в закладку (CTRL+D) и не забудь поделиться с друзьями:  



double arrow
Сейчас читают про: