Примеры
Пример 1. Дана символьная строка. Подсчитать в ней количество знаков препинания (. - , ; : ! * ?).
Program P1;
Var S: String; I,K: Byte;
Begin
ReadLn(S); K:=0;
For I:=1 To Length(S) Do
If S[I] In ['.','-',',',';',':', '!', '*','?']
Then K:=K+1;
WriteLn('Число знаков препинания равно',К)
End.
Пример 2. Дана строка. Сохранить в ней только первые вхождения символов, удалив все остальные.
program ex_set_3;
var m : set of char;
s : string; i : byte;
begin
write('Введите строку: ');
readln(s);
m :=[];
i := 1;
while i <= length(s) do
if s[i] in m then delete(s, i, 1)
else begin m:=m+[s[i]]; i := i + 1 end;
writeln(‘результат: ’,s)
end.
Пример 3. Дан текст на русском языке. Найти количество согласных букв в последнем слове.
Program mn_7;
uses crt;
type let=' а'..'я';
var sogl:set of let;
s:string;
I,k:byte;
begin
writeln('введите текст, заканчивающийся точкой');
readln(s);
if s[length(s)]<>'.' then s:=s+'.';
sogl :=['п','ф','х','т','с','к','ч','ш','щ','ц', 'б','в','г','д','ж','з','л','м','н','р'];
i:= length(s);
while s[i]<>' ' do begin if s[i] in sogl then k:=k+1; i:=i-1;end;
writeln(k);
end.
Пример 4. В городе имеется n высших учебных заведений, которые производят закупку компьютерной техники. Есть шесть компьютерных фирм: «Диалог», «Avicom», «Нэта», «Сервер», «Декада», «Dega.ru». Ответить на следующие вопросы:
1) в каких фирмах закупка производилась каждым из вузов?
2) в каких фирмах закупка производилась хотя бы одним из вузов?
3) в каких фирмах ни один из вузов не закупал компьютеры?
Решим задачу с использованием множеств. Для удобства дальнейших манипуляций в порядке следования занумеруем компьютерные фирмы, начиная с единицы. Занесём информации о месте закупок компьютеров каждым из вузов в отдельное множество.
Ответ на первый вопрос можно получить, выполнив пересечение всех таких множеств.
Ответ на второй вопрос – результат объединения множеств.
И, наконец, на последний – разность множества всех фирм и множества фирм, где хотя бы один вуз делал покупки.
program ex_set_1;
type firma = set of 1..6;
v = array[0..20] of firma;
const f: array [1..6] of string[10] = ('Диалог', 'Avicom', 'Нэта', 'Сервер', 'Декада', 'Dega.ru');
{процедура ввода информации о закупке компьютеров в очередной фирме}
procedure vvod(var a: firma);
var i: byte; ans: 0..1;
begin
a:= [];
for i := 1 to 6 do
begin
Write('Вуз покупал компьютеры в фирме ', f[i], ' (1 - да, 0 - нет)? '); ReadLn(ans);
if ans = 1 then a:=a+[i]
end;
end;
{процедура вывода элементов массива, номера которых содержатся в множестве}
procedure Print(a : firma);
var i: byte;
begin
for i := 1 to 6 do if i in a then write(f[i]:10);
writeln
end;
{Процедура, дающая ответ на первый вопрос}
procedure Rez1(a: v; n : byte; var b : firma);
var i : byte;
begin
b := [1..6];
for i := 0 to n-1 do b := b * a[i];
end;
{Процедура, дающая ответ на второй вопрос}
procedure Rez2(a: v; n : byte; var b : firma);
var i : byte;
begin
b := [];
for i := 0 to n-1 do b := b + a[i];
end;
var a: v; n, i : byte; c : firma;
begin
write('Сколько вузов делали закупку? '); readln(n);
for i := 0 to n-1 do vvod(a[i]);
Rez1(a, n, c);
writeln('Каждый из вузов закупил компьютеры в фирмах: '); Print(c);
Rez2(a, n, c);
writeln('Хотя бы один из вузов закупил компьютеры в фирмах: '); Print(c);
writeln('Ни один из вузов не закупил компьютеры в фирмах: '); Print([1..6]-c);
end.
Пример 5. Из множества целых чисел 1..20 выделить: множество чисел, делящихся без остатка на 6; множество чисел, делящихся без остатка или на 2, или на 3.
program mnog2;
const n=20;
var n2,n3,n6,n23: SET OF 1..N;
k:1..N;
begin
n2:=[ ]; n3:=[ ];
for k:=2 to n do
begin
if (k mod 2)=0 then n2:=n2+[k];
if (k mod 3)=0 then n3:=n3+[k];
end;
n6:=n2*n3;
n23:=n2+n3;
writeln('на 6 делятся числа:');
for k:=1 to n do
if k in n6 then write(k:3);
writeln;
writeln('на 2 или на 3 делятся числа:');
for k:=1 to n do
if k in n23 then write(k:3);
writeln
end.
Пример 6. Разгадывание ребусов.
+ МУХА
МУХА
СЛОН
Каждая буква - это цифра, разным буквам соответствуют разные цифры. Необходимо заменить буквы цифрами так, чтобы получилось верное равенство. Найти все решения. Для решения этой задачи используется метод перебора с возвратом. Используем множество S1 для хранения цифр слова МУХА, причем будем вносить в него цифры последовательно, учитывая уже внесенные цифры. Начальное значение S1 - пустое множество. после выбора всех цифр первого слова создаем его числовой эквивалент и числовой образ слова СЛОН. Выделяем цифры СЛОНа (множество S2)и если слова состоят из разных цифр (то есть пересечение S1 и S2 пустое) и все цифры СЛОНа разные (то есть пересечение множеств цифр тоже пустое), то выводим решение на экран. Если же нет, то идет возврат - удаляем из множества S1 последнюю внесенную цифру и пытаемся выбрать еще одно значение. Таким образом, мы перебираем все возможные варианты и выводим на экран только те, которые удовлетворяют равенству.
Заметим, что значение буквы М в слове МУХА может иметь значения от 1 до 4, а буква А в этом же слове не может быть равна 0.
Program Rebus;
Type
MN = set of 0..9;
Var
m, u, h, a : 0..9;
n1, n2 : Integer;
s, l, o, n : 0..9;
S1, S2 : MN;
Procedure Print(x, y : Integer);
Begin
writeln(x:5);
writeln('+');
writeln(x:5);
writeln(' ');
writeln(y:5);
End;
Begin
S1 := [ ];
S2 := [ ];
for m := 1 to 4 do
begin
S1 := S1+[m];
for u := 0 to 9 do
if Not(u in S1)
then
begin
S1 := S1+[u];
for h := 0 to 9 do
if Not (h in S1)
then
begin
S1 := S1+[h];
for a := 1 to 9 do
if Not (a in S1)
then
begin
S1 := S1+[a];
n1 := 1000*m+100*u+10*h+a;
n2 := 2*n1;
s := n2 div 1000;
l :=n2 div 100 mod 10;
o := n2 div 10 mod 10;
n := n2 mod 10;
S2 := [s, l, o, n];
if (S1*S2=[ ]) and ([s]*[l]*[o]*[n]=[ ])
then
Print (n1, n2);
S1 := S1-[a];
end;
S1 := S1-[h];
end;
S1 := S1-[u];
end;
S1 := S1-[m];
end;
End.