mnoj (Методичка С++), страница 2

next, nn, i:integer;

begin

if m=1 then begin numset:=[m+1..n];rez:=[1];next:=m+1 end

else begin numset:=[m..n];rez:=[ ];next:=m; end;

while numset <> [ ] do

begin

nn:=next;

while nn <= n do

begin

numset:=numset -[nn]; { удаление числа nn и кратных ему из множества}

nn:=nn+next;

end;

rez:=rez+[next];

repeat

inc(next);

until (next in numset) or (next > n)

end;

writeln(' Простые числа в диапазоне ',m:3,'..',n:3,' в обратном порядке:');

for i:=n downto m do if i in rez then write(i:4);

readln;

end.

Пример 4. Программа подсчитывает количество различных цифр в десятичной записи натурального числа.

program exmnoj4;

TYPE long=0..maxlongint;

FUNCTION count(n:longint):word;

TYPE cifra=set of 0..9; {новый тип - множество десятичных цифр}

VAR sd:cifra; {множество десятичных цифр}

k:word;d:0..9;

begin

sd:=[ ]; {задание значения множества с помощью операции присваивания: в начале sd пустое множество}

k:=0;

repeat

d:=n mod 10;

sd:=sd+[d];{ определение очередной цифры числа n и запись ее во множество}

n:=n div 10;{ определение очередного значения числа n}

until n=0;

for d:=0 to 9 do if d in sd then k:=k+1;

count:=k

end;

VAR mn:long;

begin

writeln('Введите десятичное число');

readln(mn);

writeln(' В числе ',mn,' ',count(mn):5,' различных десятичных букв ');

end.

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

1 - встречаются в каждом слове строки;

2 - встречаются только в одном слове строки;

3 - встречаются хотя бы в одном слове строки;

4 - встречаются более чем в одном слове строки;

слова разделены пробелами

program exmnoj5;

TYPE simv=set of char;

CONST b: simv = ['a','e','i','o','u','y'];

VAR rezul: simv;

st: string;

key: integer;

ch: char;

PROCEDURE prinmn(kl:integer;s:string;var rez:simv);

VAR mnsl, {множество гласных, встречающихся в текущем слове}

mn:simv; { множество гласных, встречающихся в строке}

sl:string; z,m,i,j,k:integer; ch:char;

begin

z:=0;

mn:=[ ];

k:=length(s);

i:=1; { номер символа в строке}

j:=1; { номер первого символа в очередном слове}

while i<=k do

begin

while (s[i]<>' ') and (i<=k) do i:=i+1;

sl:=copy(s,j,i-j); { выделение слова}

z:=z+1; { номер слова}

mnsl:=[ ];

if z=1 then begin

for m:=1 to i-j do

if sl[m] in b then mnsl:=mnsl+[sl[m]];

case kl of

1,3: rez:=mnsl; { rez - результат}

2,4: begin

rez:=mnsl;

mn:=mnsl;

end

end

end

else begin

mnsl:=[];

for m:=1 to i-j do

if (sl[m] in b) then mnsl:=mnsl+[sl[m]];

case kl of

1: rez:=rez*mnsl;

3: rez:=rez+mnsl;

2,4: begin

rez:=rez+mnsl-(mnsl*mn);

mn:=mn+mnsl;

end

end

end;

i:=i+1; j:=i;

end;

if kl=4 then rez:=mn-rez;

end;

begin

repeat

writeln(' Введи ключ = 1..4 ');

readln(key);

writeln(' введите исходную строку или ввод');

readln(st); { чтение исходной строки}

if length(st)<>0 then

begin

writeln('Исходная строка');

writeln(st);

prinmn(key,st,rezul);

case key of

1: writeln(' гласные, которые входят в каждое слово');

2: writeln(' гласные, входящие только в одно слово');

3: writeln(' гласные, входящие хотя бы в одно слово');

4: writeln(' гласные, входящие более чем в одно слово');

end;

for ch:=#0 to #255 do if ch in rezul then write(ch:2);

writeln;

end

until length(st)=0;

end.