Примеры программы
Программа 1. Решето Эратосфена.
{В примере, иллюстрирующем работу с множествами, реализуется алгоритм выделения из первой сотни натуральных чисел всех простых чисел. В основе алгоритма лежит прием "решета Эратосфена". Алгоритм написан на языке программирования Turbo-Pascal.}
Uses crt; Const N=100; {количество элементов исходного множества} Type SetN=set of 1..N; var n1, next, I : word; {вспомогательные переменные } BeginSet, {исходное множество } PrimerSet: SetN; {множество простых чисел } Begin Clrscr; {почистить экран} BeginSet:=[2..N]; {создать исходное множество} PrimerSet:=[1]; {первое простое число} next:=2; {следующее простое число} while BeginSet <> [ ] do {начало основного цикла} begin n1:=next; {n1-число, кратное очередному простому (next)} while n1<=N do {цикл удаления из исходного множества непростых чисел} begin BeginSet:=BeginSet-[n1]; n1:=n1+next {следующее кратное} end; {конец цикла удаления} repeat {получить следующее простое число, которое есть первое не вычеркнутое из исходного множества} inc(next) until(next in BeginSet) or (next > N) end; {конец основного цикла} {вывод результата} textcolor(15); {задание цвета} for I:=1 to N do if i in PrimerSet then write(I:8); readlen; end.
Программа 2. Простые числа в порядке убывания от 200.
{Находит и пишет все простые числа в порядке убывания от 2 до 200. Алгоритм написан на языке программирования Turbo-Pascal.}
Uses crt; const n=197; var
i,q,w,e,r,t:integer; prost:array[1..n] of integer;
begin clrscr; e:=1; r:=0; for q:=1 to n do begin r:=0; for w:=2 to n-1 do if (q<>w) and (q mod w = 0) then r:=1; {prost[e]:=q; e:=e+1;}
if r=0 then begin{begin write(q,' ');}
prost[e]:=q; e:=e+1; end; end;
for i:=e downto 2 do begin write (prost[i],' '); if wherex>70 then writeln;
end; readln; end.
Программа 3. Поиск литер в строке.
{Поиск числа вхождений в данную сроку литер a, c, e, h. Алгоритм написан на языке программирования Turbo-Pascal.}
Uses crt; type liter_set = set of char;
var c:integer; let: liter_set; a:char;
begin clrscr; let:=['a','c','e','h'];
repeat a:=readkey; write(a); if a in let then c:=c+1; until a = '.'; writeln; writeln('Общее число вхожений литер a,c,e,h в вашу запись:',c); readln;
end.
