mnoj (516218), страница 2
Текст из файла (страница 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.