Оператор выбора

Caseвыражениеof

Список значений 1 :оператор 1;

Список значений 2 : оператор 2;

…

Список значений n:операторn;

else оператор;

end;

Программа, определяющая этаж по введённому с клавиатуры номеру квартиры (в пятиэтажном доме один подъезд по четыре квартиры на каждом этаже).

Program dom;

UsesCrt;

var х : Integer;

Begin

Clrscr;

write('Введите номер квартиры: ');

readln(x);

Case x of

1, 2, 3, 4: writeln(‘Первый этаж’);

5, 6, 7, 8: writeln(‘Второй этаж’);

9, 10, 11, 12: writeln(‘Третий этаж’);

13, 14, 15, 16: writeln(‘Четвёртый этаж’);

17, 18, 19, 20: writeln(‘Пятый этаж’);

end;

else writeln(‘Квартиры с таким номером в доме нет’);

readln;

End.

Программа, определяющая номер подъезда и этаж по введённому с клавиатуры номеру квартиры (в пятиэтажном доме два подъезда по четыре квартиры на каждом этаже).

Program dom;

UsesCrt;

var х : Integer;

Begin

Clrscr;

write('Введите номер квартиры: ');

readln(x);

Case x of

1, 2, 3, 4: writeln(‘Первый подъезд. Первый этаж’);

5, 6, 7, 8: writeln(‘Первый подъезд. Второй этаж’);

9, 10, 11, 12: writeln(‘Первый подъезд. Третий этаж’);

13, 14, 15, 16: writeln(‘Первый подъезд. Четвёртый этаж’);

17, 18, 19, 20: writeln(‘Первый подъезд. Пятый этаж’);

21, 22, 23, 24: writeln(‘Второй подъезд. Первый этаж’);

25, 26, 27, 28: writeln(‘Второй подъезд. Второй этаж’);

29, 30, 31, 32: writeln(‘Второй подъезд. Третий этаж’);

33, 34, 35, 36: writeln(‘Второй подъезд. Четвёртый этаж’);

37, 38, 39, 40: writeln(‘Второй подъезд. Пятый этаж’);

else writeln(‘Квартиры с таким номером в доме нет’);

end;

readln;

End.

Программа, определяющая по номеру месяца – время года.

Program year;

UsesCrt;

var х : Integer;

Begin

Clrscr;

write('Введите номер месяца: ');

readln(x);

Case x of

12, 1, 2: writeln(‘Зима’);

3, 4, 5: writeln(‘Весна’);

6, 7, 8: writeln(‘Лето’);

9, 10, 11: writeln(‘Осень’);

end;

readln;

End.

В старояпонском календаре был принят две­надцатилетний цикл. Годы "внутри цикла носили названия животных: крысы, коровы, тигра, зайца, дракона, змеи, ло­шади, овцы, обезьяны, петуха, собаки и свиньи. Написать программу, которая позволяет ввести номер года и печатает его название по старояпонскому календарю.

Справка:1996 г. — Год Крысы — начало очередного цикла.

Program Goroskop;

UsesCrt;

var Year : integers;

Begin

Clrscr;

write('Введите год ');

readln(Year);

Case Year mod 12 of

0: writeln('Год Обезьяны');

1: writeln(' Год Петуха');

2: writeln(' Год Собаки');

3: writeln(' Год Свиньи');

4:	writeln(‘	Год Крысы');
5:	writeln(‘	Год Коровы');
6: :	writeln(‘	Год Тигра');
7:	writeln(‘	Год Зайца');
8:	writeln(‘	Год Дракона');
9:	writeln(‘	Год Змеи');
10:	writeln(‘	Год Лошади');
11:	writeln(‘	Год Овцы');

end;

readln;

End.

Циклы

Цикл с предусловием:	Цикл с постусловием:	Цикл со счётчиком:
while условие do begin оператор 1; оператор 2; … оператор n; end;	repeat оператор 1; оператор 2; … оператор n; until условие;	for переменная:= начальное значение to конечное значение do begin оператор 1; оператор 2; … оператор n; end;

Программа, выводящая на экран сто символов (*).

Цикл с предусловием:	Цикл с постусловием:
ProgramStar; UsesCrt; var х : Integer; Begin Clrscr; x:=1; while x<100 do begin write(‘*’); x:=x+1; end; readln; End.	ProgramStar; UsesCrt; var х : Integer; Begin Clrscr; x:=1; repeat write(‘*’); x:=x+1; until x>=100; readln; End.
Цикл со счётчиком:
(1 способ)	(2 способ)
ProgramStar; UsesCrt; var х : Integer; Begin Clrscr; for x:=1 to 100 do begin write(‘*’); end; readln; End.	Program Star; UsesCrt; var х : Integer; Begin Clrscr; for x:=100 downto 1 do begin write(‘*’); end; readln; End.

Программа, вычисляющая факториал числа, введённого с клавиатуры.

Цикл с предусловием:	Цикл с постусловием:
ProgramFaktorial; UsesCrt; var i, х, s : Integer; Begin Clrscr; write(‘Введите число’); readln(x); i:=1; s:=1; while i<x do begin s:=s*i+s; i:=i+1; end; writeln(‘Факториал числа’, x, ‘=’, s); readln; End.	Program Faktorial; UsesCrt; var i, х, s : Integer; Begin Clrscr; write(‘Введите число’); readln(x); i:=1; s:=1; repeat s:=s*i+s; i:=i+1; until i>x; writeln(‘Факториал числа’, x, ‘=’, s); readln; End.
Цикл со счётчиком:
ProgramFaktorial; UsesCrt; var i, х, s : Integer; Begin Clrscr; write(‘Введите число’); readln(x); i:=1; s:=1; for i=1 to x do s:=s*i+s; writeln(‘Факториал числа’, x, ‘=’, s); readln; End.

Программа, вычисляющая сумму слагаемых .

Цикл с предусловием:	Цикл с постусловием:
Programsumma; UsesCrt; var i, s : Integer; Begin Clrscr; i:=1; s:=0; while i<100 do begin s:=1/i+s; i:=i+1; end; writeln(‘Сумма элементов равна’, s); readln; End.	Program summa; UsesCrt; var i, s : Integer; Begin Clrscr; i:=1; s:=0; repeat s:=1/i+s; i:=i+1; until i>100; writeln(‘Сумма элементов равна’, s); readln; End.
Цикл со счётчиком:
Programsumma; UsesCrt; var i, х, s : Integer; Begin Clrscr; i:=1; s:=0; for i=1 to 100 do s:=1/i+s; writeln(‘Сумма элементов равна’, s); readln; End.

Программа вывода таблицы соответствия между температурными шкалами Цельсия и Фаренгейта в интервале температур от 0ºС до 100ºС.

Цикл с предусловием:	Цикл с постусловием:
Рrogram Celsius to Fahrenheit; Uses Crt; var i, Celsius: Integer; Fahrenheit: real; Вegin Clrscr; writeln("Таблица соответствия между температурными шкалами'); writeln('Цельсия и Фаренгейта'); writeln; i:=0; while i <= 20 do begin Celsius := 5 * i; Fahrenheit := 32 + Celsius * 9 div 5; write(‘ С =' , Celsius) ; write(‘ F =', Fahrenheit); writeln; i:=i+1; end; readln; End.	Рrogram Celsius to Fahrenheit; Uses Crt; var i, Celsius: Integer; Fahrenheit: real; Вegin Clrscr; writeln("Таблица соответствия между температурными шкалами'); writeln('Цельсия и Фаренгейта'); writeln; i:=0; repeat Celsius := 5 * i; Fahrenheit := 32 + Celsius * 9 div 5; write(‘ С =' , Celsius) ; write(‘ F =', Fahrenheit); writeln; i:=i+1; until i>20; readln; End.
Цикл со счётчиком:
Рrogram Celsius to Fahrenheit; Uses Crt; var i, Celsius: Integer; Fahrenheit: real; Вegin Clrscr; writeln("Таблица соответствия между температурными шкалами'); writeln('Цельсия и Фаренгейта'); writeln; for i := 0 to 20 do begin Celsius := 5 * i; Fahrenheit := 32 + Celsius * 9 div 5; write(‘ С =' , Celsius) ; write(‘ F =', Fahrenheit); writeln; end; readln; End.

Программа, загадывающая число от 0 до 10. Если пользователь его угадывает, то программа поздравляет его, а если нет, то просит попытаться ещё раз, но убавляя количество призовых баллов.

Рrogram roulette;

Uses Crt;

var number, guess, bonus: byte;

Вegin

Clrscr;

bonus:=10;

Randomize;

number := Random(ll);

writeln('Задумано целое число от 0 до 10. Угадайте!');

writeln;

wr1teln('Введите целое число от 0 до 10');

readln(guess);

while guess <> number do

begin

Dec(bonus);

writeln('Bы не угадали.');

writeln;

if guess < number then writeln('Ваше число меньше задуманного')

else

writeln('Ваше число больше задуманного');

writeln('Попытайтесь еще раз!');

readln(guess);

end;

writeln('Поздравляю! Вы угадали и набрали ', bonus, ' очков');

readln;

Еnd.

Вычисление произведения пары неотрицательных вещественных чисел вводимых с клавиатуры и сумму всех чисел.

Program cycle;

Uses Crt;

var x, y, sum: real;

otv: char;

Begin

Clrscr;

sum:=0;

repeat

write('Введите числа x,y > 0 ');

readln(x,y);

writeln('Их произведение = ',x*y:8:3);

sum:=sum+x+y;

write('Завершить программу (Д/Н)? ');

readln(otv);

until (otv='Д') or (otv='д');

writeln('Общая сумма = ',sum:8:3);

readln;

End.

Программа, определяющая является ли число совершенным. Число является совершенным, если оно равно сумме всех своих делителей, включая единицу. (Например 6=1+2+3, 28=1+2+4+7+14).

Program sover;

Uses Crt;

var а, i, s : Integer;

Begin

Clrscr;

write('Введите целое число а:');

readln(a);

s := 0;

for i := 1 to a div 2 do

if a mod i = 0 then

begin

s : = s + i;

write('+', i);

end;

if s =a then writeln('Число ', a, 'совершенное')

else writeln('Число ', a, ' не совершенное');

readln;

End.

Программа печати всех делителей натурального числа A.

Programdelit;

Uses Crt;

var a,n,c,d:word;

Вegin

CIrScr;

readln( a );

n:=1;

while ( n <= sqrt(a) ) do begin

c:=a mod n;

d:=a div n;

if c = 0 then begin

writeln( n );

if n <> d then writeln( d );

end;

inc( n );

end;

readln;

Еnd.

Программа печати всех совершенных чисел до 10000.

Programstrong;

Uses Crt;

var n,i,j,s,lim,c,d : word;

Вegin

CIrScr;

for i:=1 to 1000 do

begin

s:=1; lim:=round(sqrt(i));

for j:=2 to lim do

begin

c:=i mod j;

d:=i div j;

if c = 0 then

begin

inc(s,j);

if (j<>d) then inc(s,d); {дважды не складывать корень числа}

end;

end;

if s=i then writeln(i);

end;

readln;

Еnd.

Программу вывода на экран всех простых чисел до 500.

Programprost;

Uses Crt;

const LIMIT = 500;

var i,j,lim : word;

Вegin

CIrScr;

writeln; {перевод строки, начинаем с новой строки}

for i:=1 to LIMIT do begin

j:=2; lim:=round(sqrt(i));

while (i mod j <> 0) and (j <= lim) do inc( j );

if (j > lim) then write( i,' ' );

end;

readln;

Еnd.

Подсчет суммы цифр числа.

Programsumma;

Uses Crt;

var a,x: integer;

i,s: integer;

Вegin

CIrScr;

writeln('введите целое число');

readln( a ); x:=a;

s:=0;

while ( x<>0 ) do

begin

s := s + (x mod 10);

x := x div 10;

end;

writeln( 'Сумма цифр числа ',a,' = ', s );

readln;

Еnd.

Программа перевода чисел из деся­тичной системы счисления в римскую (от 1 до 3999 включительно).

Programdectoroman;

Uses Crt;

const rom: array[1..13] of string[2] = ('I’, ‘IV’, ‘V’, ‘IX’, 'X', 'XL', 'L', 'XC', 'С', 'CD', 'D', 'CM', 'M');

dec: array[1..13] of word = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);

var n: word;

s: string;

i: byte;

Begin

Clrscr;

write('Введите число в десятичной системе счисления: ');

readin(n) ;

s := ‘ ‘;

i := 13;

while n <> 0 do

begin

while n >= dec[i] do

begin

n : = n - dec[ i ];

s := s + rom[i];

end;

i := i – 1;

end;

writeln('Число в римской системе счисления: ', s);

readln;

End.

Кодировка: Пример простой кодировки (сдвиг по ключу)

-----------------------------------------------------------------------------------------------------

Алгоритм: каждый код символа увеличивается на некоторое число - "ключ"

-----------------------------------------------------------------------------------------------------

Programkod;

Uses Crt;

var s: string;

i, key: integer;

Вegin

CIrScr;

writeln('Введите текст');

readln(s);

writeln('Введите ключ (число от 1 до 255)');

readln(key);

for i:=1 to length(s) do s[i]:=char( ord(s[i]) + key );

writeln('Зашифрованный текст: ',s);

readln;

Еnd.

Обработка текста: Разрешение ввода только цифр

----------------------------------------------------------------------------------

На входе - текст с цифрами (но будут вводиться только цифры)

----------------------------------------------------------------------------------

Programnumber;

Uses Crt;

const ENTER #13;

var c:char;

Вegin

CIrScr;

writeln('Вводите буквы и цифры');

c:=readkey;

while (c<>ENTER) do

begin

if c in ['0'..'9'] then write(c);

c:=readkey;

end;

writeln;

readln;

Еnd.

Массивы

Одномерный массив

Var Имя массива : array[начальный индекс .. конечный индекс] of тип данных;

Двумерный массив

Var Имя массива : array[номер первой строки .. номер последней строки , номер первого столбца номер последнего столбца] of тип элементов массива;

Вычисление значения многочлена степени N, коэффициенты которого находятся в массиве A в точке X по схеме Горнера.

Pn(x) = A[0]*X^n + A[1]*X^(n-1) + ... + A[n-1]*X + A[n] =

= (...((A[0]*X + A[1])*X + A[2])*X + ... + A[n-1])*X + A[n].

Program Scheme Gorner;

type Mas = array[0..100] of integer;

var A: Mas;

i, j, n: integer;

x, p: real;

Begin

write('степень многочлена = ');

readln(n);

writeln('введите целые коэффициенты : ');

for i:=0 to n do read(A[i]);

write('значение X = ');

readln(x);

p:=0;

for i:=0 to n do p:=p*x+A[i];

writeln('Pn(X) = ',p);

readln;

End.

Вычисление суммы элементов заданного одномерного числового массива А=(а₁, а₂, …, а_n).

Program Summa;

UsesCrt;

TypeMas = Array [1..20] of Real;

varA : Mas;

i, N : Integer;

S : Real;

Begin

CIrScr;

write('Введите N =');

readln(N);

For i := 1 to N do

begin

write('A [', i ,']=');

readln(A[i]);

end;

S := 0;

For i := 1 to N do S := S+A[i];

writeln;

writeln('Cyммa равна', S : 5 :1);

readln;

End.

Программа выво­дящая на экран таблицу сложения натуральных чисел от 1 до 9.

Рrogram addition table;

UsesCrt;

constn = 9;

var

a : array [1..9, 1..9] of Integer;

i, j : Integer;

Вegin

CIrScr;

for i : = 1 to n do

for j := 1 to n do a[i ,j] := i + j;

for i := 1 to n do

begin

for j := 1 to n do write(a[i, j], ‘ | ‘);

writeln;

end;

readln;

Еnd.

Формирование нового одномерного массива из элементов заданного массива. (Дан массив X(N). Получим новый массивY(N), такой, что в нём сначала идут положительные числа, затем нулевые и затем отрицательные из Х).

ProgramNewOrder;

UsesCrt;

varN, i, k : Integer;

X,Y : Array [1..20] of Real;

Begin

CIrScr;

Write(‘ Введите N =');

readln(N);

For i := 1 to N do

begin

Write('X[', i,' ] = ');

readln(X[i]);

end;

k:=0;

For i := 1 to N do

If X[i]>0 then

begin

k:=k+l;

Y[k]:=X[i];

end;

For i := 1 to N do

If X[i]=0 then

begin

k:=k+l;

Y[k]:=X[i];

end;

For i:= 1 to N do

If X[i]<0 then

begin

k:=k+l;

Y[k]:=X[i];

end;

write('O т в е т: полученный массив');

For i := 1 to N do write(Y[i]: 5 : 1);

writeln;

readln;

End.

Формирование списка кандидатов в школьную баскетбольную команду. (В баскетбольную команду могут быть приняты ученики, рост которых превышает 170 см).

Program BascetBall;

Uses Crt;

var

SurName : Array [1..30] of String; { фамилии учеников}

Height : Array [ 1.. 30]ofReal; { рост учеников }

Cand : Array [ 1.. 30] of String; { фамилии кандидатов }

NPupil, i, К : Integer { NPupil - число учеников, К — количество зачисленных}

Begin

CIrScr;

write('B КОМАНДУ ЗАЧИСЛЯЮТСЯ УЧЕНИКИ,');

writeln('POCT КОТОРЫХ ПРЕВЫШАЕТ 170CM.');

writeln;

write('Cколько всего учеников ?');

readln(NPupil);

writeln(‘ Введите фамилии и рост учеников:');

For i := 1 to NPupil do

begin

write(i,'. Фамилия -');

readln(SurName[i]);

write(' Рост-');

readln(Height[i]);

end;

writeln;

K:=0; { Составление списка команды}

For i := 1 to NPupil do

If Height[i]>170 then

begin

K:=K+1;

Cand[K] := SurName[i];

end;

If K=0 then writeln('B КЛАССЕ НЕТ КАНДИДАТОВ В КОМАНДУ.')

else

begin

writeln(‘KAHДИДATbI В БАСКЕТБОЛЬНУЮ КОМАНДУ:');

For i := 1 to К do writeln( i, '. ', Cand[i]);

end;

readln;

End.

Подсчет суммы элементов двухмерного массива.

ProgramNewOrder;

UsesCrt;

var a:array[1..10,1..2] of integer;

s:longint;

i,j:integer;

Вegin

CIrScr;

writeln('введете 20 элементов массива');

s:=0;

for i:=1 to 10 do

begin

for j:=1 to 2 do

begin

readln( a[i,j] );

s:=s+a[i,j];

end;

end;

writeln( 'Сумма элементов массива = ', s );

readln;

Еnd.

Поиск максимального элемента в массиве.

Programmax;

UsesCrt;

var a: array[1..10] of integer;

max: integer;

i: integer;

Вegin

writeln('введите 10 элементов массива');

max:=-(MAXINT+1);

for i:=1 to 10 do

begin

readln( a[i] );

if max<a[i] then max:=a[i];

end;

writeln( 'Максимальный элемент массива = ', max );

readln;

Еnd.

Поиск среднего арифметического в массиве.

Programsred;

UsesCrt;

var a: array[1..10] of integer;

s: longint;

i, n: integer;

Вegin

CIrScr;

s:=0; n:=0;

writeln('введите 10 элементов массива');

for i:=1 to 10 do

begin

readln( a[i] );

s:=s+a[i]; inc(n);

end;

writeln( 'Среднее арифметическое в массиве = ', s/n );

readln;

Еnd.

Печать всех элементов массива из интервала C..D.

Programcd;

UsesCrt;

var a: array[1..10] of integer;

c, d: integer;

i: integer;

begin

CIrScr;

writeln('введите 10 элементов массива');

for i:=1 to 10 do readln( a[i] );

writeln('введите интервал C и D');

readln( c,d );

for i:=1 to 10 do

begin

if (a[i]>=C) and (a[i]<=D) then writeln(a[i]);

end;

readln;

Еnd.

Циклический сдвиг элементов массива вправо.

Programsdvig;

UsesCrt;

var a: array[1..10] of integer;

x: integer;

i: integer;

Вegin

CIrScr;

writeln('введите 10 элементов массива');

for i:=1 to 10 do readln( a[i] );

x:=a[10];

for i:=10 to 2 do

begin

a[i]:=a[i-1];

end;

a[1]:=x;

writeln('после сдвига:');

for i:=1 to 10 do writeln( a[i] );

readln;

Еnd.

Вывод самого часто встречающегося элемента из массива.

Programchasto;

UsesCrt;

var a: array[1..10] of integer;

i, j, m, p, n: integer;

Вegin

CIrScr;

writeln('введите 10 элементов массива');

for i:=1 to 10 do readln( a[i] );

m:=1; p:=1;

for i:=1 to 10 do begin

n:=0;

for j:=1 to 10 do begin

if a[i]=a[j] then inc(n);

end;

if n>m then begin

m:=n; p:=i;

end;

end;

writeln('самый часто встречающийся элемент:', a[p]);

readln;

Еnd.

Определение все ли элементы массива различны?

Programraz;

UsesCrt;

var a:array[1..10] of integer;

i,j:integer;

Вegin

CIrScr;

writeln('введите 10 элементов массива');

for i:=1 to 10 do readln( a[i] );

i:=1;

while (i<10) and (j<11) do begin

j:=i+1;

while (j<11) and (a[i]<>a[j]) do inc(j);

inc(i);

end;

if i<11 then writeln('в массиве есть одинаковые элементы')

else writeln('все элементы массива различны');

readln;

Еnd.

АЛГОРИТМЫ СОРТИРОВКИ

Простейшая задача сортировки заключается в упорядочении элементов массива по возрастанию или убыванию. Другой задачей является упорядочение элементов массива в соответствии с некоторым критерием. Обычно в качестве такого критерия выступают значения определенной функции, аргументами которой выступают элементы массива. Эту функцию принято называть упорядочивающей функцией.

Существуют различные методы сортировки. Будем рассматривать каждый из методов на примере задачи сортировки по возрастанию массива из N целых чисел.

СОРТИРОВКА ВЫБОРОМ

Идея метода заключается в том, что находится максимальный элемент массива и меняется местами с последним элементом (с номером N). Затем, максимум ищется среди элементов с первого до предпоследнего и ставится на N-1 место, и так далее. Необходимо найти N-1 максимум. Можно искать не максимум, а минимум и ставить его на первое, второе и так далее место. Также применяют модификацию этого метода с одновременным поиском максимума и минимума. В этом случае количество шагов внешнего цикла N div 2

Вычислительная сложность сортировки выбором - величина порядка N*N, что обычно записывают как O(N*N). Это объясняется тем, что количество сравнений при поиске первого максимума равно N-1. Затем N-2, N-3, и так далее до 1, итого: N*(N-1)/2.

ПРИМЕР: Сортировка выбором по возрастанию массива A из N целых чисел.

Рrogram Vybor1;

UsesCrt;

var A: array [1..100] of integer;

N, i, m, k, x : integer;

Вegin

CIrScr;

write('количество элементов массива ');

read(N);

for i:=1 to n do read(A[i]);

for k:=n downto 2 do { k - количество элементов для поиска max }

begin

m:=1; { m - место max }

for i:=2 to k do if A[i]>A[m] then m:=i;

{меняем местами элементы с номером m и номером k}

x:=A[m]; A[m]:=A[k]; A[k]:=x;

end;

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

ПРИМЕР: Та же задача с одновременным выбором max и min.

Рrogram Vybor2;

UsesCrt;

var A: array[1..100] of integer;

N, i, m, k, x, p : integer;

Вegin

CIrScr;

write('количество элементов массива ');

read(N);

for i:=1 to n do read(A[i]);

for k:=1 to n div 2 do { k - номер пары max и min }

begin

m:=k; { m - место max }

p:=k; { p - место min }

{max и min ищутся среди элементов с k до n-k+1}

for i:=k+1 to n-k+1 do

if A[i]>A[m] then m:=i

else if A[i]<A[p] then p:=i;

{меняем местами элементы с номером p и номером k}

x:=A[p]; A[p]:=A[k]; A[k]:=x;

if m=k then m:=p;

{если max стоял на месте k, то сейчас он на месте p}

{меняем местами элементы с номером m и номером n-k+1}

x:=A[m]; A[m]:=A[n-k+1]; A[n-k+1]:=x;

end;

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

СОРТИРОВКА ОБМЕНОМ (методом "пузырька")

Идея метода заключается в том, что последовательно сравниваются пары соседних элементов массива. Если они располагаются не в том порядке, то совершаем перестановку, меняя местами пару соседних элементов. После одного такого прохода на последнем месте номер N окажется максимальный элемент ("всплыл" первый "пузырек"). Следующий проход должен рассматривать элементы до предпоследнего и так далее. Всего требуется N-1 проход. Вычислительная сложность сортировки обменом O(N*N).

ПРИМЕР: Сортировка обменом по возрастанию массива A из N целых чисел. (Базовый вариант)

Рrogram Obmen1;

var A: array[1..100] of integer;

N, i, k, x : integer;

Вegin

CIrScr;

write('количество элементов массива ');

read(N);

for i:=1 to n do read(A[i]);

for k:=n-1 downto 1 do { k - количество сравниваемых пар }

for i:=1 to k do

if A[i]>A[i+1] then

{меняем местами соседние элементы}

begin x:=A[i]; A[i]:=A[i+1]; A[i+1]:=x; end;

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

Можно заметить, что если при выполнении очередного прохода в сортировке обменом не произведено ни одной перестановки, то это означает, что массив уже упорядочен. Таким образом, можно модифицировать алгоритм, чтобы следующий проход делался только при наличии перестановок в предыдущем.

ПРИМЕР: Сортировка обменом с проверкой факта перестановки.

Рrogram Obmen2;

UsesCrt;

var A: array [1..100] of integer;

N, i, k, x : integer; p: boolean;

Вegin

CIrScr;

write('количество элементов массива ');

read(N);

for i:=1 to n do read(A[i]);

k:=n-1; {количество пар при первом проходе}

p:=true; {логическая переменная p истинна, если были

перестановки, т.е. нужно продолжать сортировку}

while p do

begin

p:=false;

{Начало нового прохода. Пока перестановок не было.}

for i:=1 to k do

if A[i]>A[i+1] then

begin

x:=A[i]; A[i]:=A[i+1]; A[i+1]:=x;

{меняем элементы местами}

p:=true; {и запоминаем факт перестановки}

end;

k:=k-1;

{уменьшаем количество пар для следующего прохода}

end;

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

Следующая модификация алгоритма сортировки обменом получается при запоминании места последней перестановки. Если при очередном проходе последней парой элементов, которые поменялись местами, были A[i] и A[i+1], то элементы массива с i+1 до последнего уже стоят на своих местах. Использование этой информации позволяет нам сделать количество пар для следующего прохода равным i-1.

ПРИМЕР: Сортировка обменом с запоминанием места последней перестановки.

Рrogram Obmen3;

UsesCrt;

var A: array [1..100] of integer;

N, i, k, x, m : integer;

Вegin

CIrScr;

write('количество элементов массива ');

read(N);

for i:=1 to n do read(A[i]);

k:=n-1; {количество пар при первом проходе}

while k>0 do

begin

m:=0;

{пока перестановок на этом проходе нет, место равно 0}

for i:=1 to k do

if A[i]>A[i+1] then

begin

x:=A[i]; A[i]:=A[i+1]; A[i+1]:=x; {меняем элементы местами}

m:=i; {и запоминаем место перестановки}

end;

k:=m-1; {количество пар зависит от места последней перестановки}

end;

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

ШЕЙКЕРНАЯ СОРТИРОВКА

Этот алгоритм, по сути, является модификацией сортировки обменом. Отличие состоит только в том, что если в сортировке обменом проходы осуществлялись только в одном направлении, то здесь направление каждый раз меняется. В шейкерной сортировке также можно проверять факт перестановки или запоминать место последней перестановки. В базовом алгоритме количество двойных проходов равно N div 2. Вычислительная сложность шейкерной сортировки O(N*N).

ПРИМЕР: Шейкерная сортировка по возрастанию массива A из N целых чисел.

Рrogram Shaker;

UsesCrt;

var A: array [1..100] of integer;

N, i, k, x, j, d : integer;

Вegin

CIrScr;

write('количество элементов массива ');

read(N);

for i:=1 to n do read(A[i]);

d:=1; i:=0;

for k:=n-1 downto 1 do { k - количество сравниваемых пар }

begin

i:=i+d;

for j:=1 to k do

begin

if (A[i]-A[i+d])*d>0 then

{меняем местами соседние элементы}

begin x:=A[i]; A[i]:=A[i+d]; A[i+d]:=x; end;

i:=i+d;

end;

d:=-d;

{меняем направление движения на противоположное}

end;

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

СОРТИРОВКА ВКЛЮЧЕНИЕМ

Идея данного метода состоит в том, что каждый раз, имея уже упорядоченный массив из K элементов, мы добавляем еще один элемент, включая его в массив таким образом, чтобы упорядоченность не нарушилась. Сортировка может производиться одновременно со вводом массива.

В начале сортировки упорядоченная часть массива содержит только один элемент, который вводится отдельно или, если массив уже имеется, считается единственным, стоящим на нужном месте. Различные методы поиска места для включаемого элемента приводят к различным модификациям сортировки включением.

При использовании линейного поиска вычислительная сложность сортировки включением составляет O(N*N), а при использовании двоичного поиска - O(N*LogN) (имеется в виду логарифм по основанию 2).

ПРИМЕР: Сортировка по возрастанию массива A из N целых чисел включением с линейным поиском.

Рrogram Include1;

UsesCrt;

var A: array [1..100] of integer;

N, i, k, x : integer;

Вegin

CIrScr;

write('количество элементов массива ');

read(N);

read(A[1]); {for i:=1 to n do read(A[i]);}

{k - количество элементов в упорядоченной части массива}

for k:=1 to n-1 do

begin

read(x); {x:=A[k+1];}

i:=k;

while (i>0)and(A[i]>x) do

begin

A[i+1]:=A[i];

i:=i-1;

end;

A[i+1]:=x;

end;

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

ПРИМЕР: Сортировка по возрастанию массива A из N целых чисел включением с двоичным поиском.

Рrogram Include2;

UsesCrt;

var A: array [1..100] of integer;

N, i, k, x, c, left, right : integer;

Вegin

CIrScr;

write('количество элементов массива ');

read(N);

read(A[1]); {for i:=1 to n do read(A[i]);}

{k - количество элементов в упорядоченной части массива}

for k:=1 to n-1 do

begin

read(x); {x:=A[k+1];}

left:=1; right:=k;

{левая и правая граница фрагмента для поиска}

while left<right do

{двоичный поиск последнего вхождения}

begin

c:=(left+right+1) div 2;

{середина с округлением в большую сторону}

if x>=A[c] then left:=c

{берем правую половину с серединой}

else right:=c-1; {берем левую половину без середины}

end;

if x>=A[left] then left:=left+1;

{сдвигаем на 1 вправо часть массива, освобождая место

для включения x}

for i:=k downto left do A[i+1]:=A[i];

A[left]:=x;

end;

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

СОРТИРОВКА С ИСПОЛЬЗОВАНИЕМ ВЕКТОРА ИНДЕКСОВ

В отличии от всех ранее изложенных методов сортировки, этот не является самостоятельным алгоритмом, а представляет собой идею, которую можно применять к любому из них. Идея заключается в том, что вводится дополнительный массив B, который принято называть вектором индексов. Числа в нем говорят о том, в каком порядке нужно смотреть на элементы из A, например: Массив A : 4 7 3 5 Массив B : 3 1 4 2 { A[3] A[1] A[4] A[2] }

В начале программы в вектор индексов B записываются последовательно натуральные числа от 1 до N. При работе любой сортировки вместо элемента A[i] обращаются к элементу A[B[i]]. Это сделано для того, чтобы менять местами не элементы массива A, а их индексы, т.е. элементы массива B.

Процедуры

procedure имя процедуры(var параметр 1: тип 1;

var параметр 2 : тип 2; раздел описаний процедуры

. . .

var параметр n : тип n;

begin

раздел операторов процедуры

end;

Нахождение наибольшего числа из четырёх.

Program largest;

Uses Crt;

vara, b, c, d, mab, mcd, max : Real;

Procedure max2(x, у : Real; var z : Real);

Begin

if x >= у then z := x else z := y; {z = max(x ,y)}

end; {max2}

Begin {Основная программа}

CIrScr;

write('Введите четыре числа ');

readln(a, b, c, d);

max2(a, b, mab); {Вызов процедуры}

max2(с, d, mcd); {Процедура работает именно в момент вызова}

max2(mab, mcd, max);

writeln ('Большее из ', а:10:5, b:19:5, с:10:5, d:10:5, ‘ = ‘, max:10:5);

readln;

End.

Определение принадлежности хотя бы одной точки заданного множества точек на плоскости внутренней области круга с центром в точке(a, b) и радиусом R.

Program SetOfPoints;

Uses Crt;

Type Mas = Array [1..20] of Real;

Var X, Y: Mas; {массивы координат точек}

i, NPoints : Integer; {NPoints - количество точек}

a, b, Radius: Real; {координаты центра и радиус}

Flag: Boolean;

ProcedureInput; {описание процедуры ввода данных}

Begin

CIrScr;

write('Введите координаты центра круга:');readln(a,b);

write(‘Введите радиус круга:');readln(Radius);

write('Введите количество точек:');readln(NPoints);

For i := 1 to NPoints do

begin

writeln(i: 4, '-я точка');

write('X ='); readln(X[i]);

write(‘Y = '); readln(Y[i]);

end;

writeln

End; {of Input}

Procedure Inside(var Flag : Boolean); {описание процедуры проверки}

Begin{принадлежности точек области}

Flag := FALSE; i:=l;

While (i<=NPoints) and not Flag do

If Sqr(X[i]-a)+Sqr(Y[i]-b)<Sqr(Radius) then Flag := TRUE else i:=i+l;

End; {of Inside}

Procedure Output( Flag: Boolean); {описание процедуры}

Begin{вывода результатов}

write('Oт в е т: в множестве точек');

If Flag then writeln('coдepжaтcя') else writeln('He содержатся');

writeln(' точки, принадлежащие заданной области.');

readln;

End; {of Output}

Begin

Input; {вызов процедуры ввода данных}

Inside(Flag); {вызов процедуры проверки принадлежности}

Output(Flag); {вызов процедуры вывода результатов}

End.

Определение наличия среди элементов главной диагонали заданной целочисленной матрицы А(N,N) хотя бы одного положительного нечётного элемента.

Program Diagonal;

Uses Crt;

Type Mas = Array [1.. 10, 1.. 10] of Integer;

var A: Mas;

N, i, j: Integer;

Flag: Boolean;

Procedure InputOutput(Var A : Mas); {описание процедуры ввода- вывода исходных данных}

Begin

CIrScr;

write('Количество строк и столбцов — ');readln(N);

For i:= 1 to N do

For j := 1 to N do

begin

write('A[', i, ‘, ‘, j, '] = ');

readln(A[i, j]);

end;

writeln;

writeln('Заданная матрица ;');

For i := 1 to N do

begin

For j := 1 to N do Write(A[i, j] : 5);

writeln;

end;

writeln;

End; { of InputOutput }

Procedure Solution(Var A : Mas); {описание процедуры поиска решения}

var Flag : Boolean;

Begin

Flag:=FALSE; i:=l;

While (i<=N) and not Flag do

If (A[i, i]>0) and (A[i, i] mod 2 = 1) then Flag:=TRUE else i:=i+l;

writeln(‘ Ответ :’);

write('Cpeди элементов главной диагонали ');

If Flag then writeln('ecть нечетные положительные.') elsewriteln('нет нечетных положительных.');

readln;

End; { Solution}

Begin

InputOutput(A); {вызов процедуры ввода-вывода данных }

Solution(A); {вызов процедуры поиска решения задачи}

End.

Решение биквадратного уравнения ax⁴+bx²+c=0.

Program bikvur;

Uses Crt;

var

а, b, с : Real;

{Глобальные переменные}

yl, y2 : Real;

flag : Boolean;

Procedure kvur(var yl,y2 : Real; var flag : Boolean);

var d : Real;

{Дискриминант локальная переменная}

begin

d := sqr(b) - 4 * a * с; {Глобальные переменные a, b и с известны процедуре}

if d >= 0 then

begin

flag := true;

yl := (-b + sqrt(d)) / 2 / a;

y2 := (-b - sqrt(d)) /2/a;

end

else flag := false;

end; {kvur}

Begin

CIrScr;

write('Введите значения коэффициентов a, b, с:’);

readln(a, b, c);

kvur(yl, y2, flag);

if flag then

begin

if yl >= 0 then writeln(‘xl= ', sqrt(yl):10:5, ' x2=', -sqrt(yl):18:5)

else writeln('Вещественных корней xl и х2 нет');

if y2 >= 0 then writeln(‘x3= ', sqrt(y2):10:5, ' x4=', -sqrt(y2):10:5)

else writeln('Вещественных корней хЗ и х4 нет');

end

else writeln('Вещественных корней нет');

readln;

End.

Задача о Ханойских башнях. Формулировка задачи:

Дано три стержня. На первом стержне размещены п дисков разных диамет­ров в порядке их уменьшения, так что сверху находится диск с наименьшим диаметром.

Требуется переложить диски на третий стержень, соблюдая следующие правила:

• можно перемещать лишь по одному диску;

• больший диск не разрешается класть на меньший;

• откладывать диски в сторону не разрешается.

Program Hanoy;

Uses Crt;

var n: Integer;

Procedure Solve(h, а, b, с: Integer); {h - количество дисков; а - номер стержня, с которого осуществляется перенос; b - номер стержня, на который осуществляется перенос; с - номер свободного стержня}

Begin

If h>0 then

Begin

Solve(h-1, a, c, b);

writeln(' Диск ' , h, ' переносится со стержня ' , a, ' на стержень ' , b) ;

Solve(h-1, с, b, а);

End;

End; { Solve }

Begin

CIrScr;

write(' Введите количество дисков n=') ;

readln(n) ;

Solve(n, 1, 3, 2);

readln;

End.

Рекурсивные алгоритмы: генерация перестановок.

Program bikvur;

Uses Crt;

const n = 3; { количество элементов в перестановке}

var a:array[1..n] of integer;

index : integer;

procedure generate (l,r:integer);

var i, v:integer;

begin

if (l=r) then begin

for i:=1 to n do write(a[i],' ');

writeln;

end else begin

for i := l to r do begin

v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[j]}

generate(l+1,r); {вызов новой генерации}

v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[j]}

end;

end;

end;

Вegin

CIrScr;

for index := 1 to N do A[index]:=index;

generate( 1,n );

readln;

Еnd.

СОРТИРОВКА ХОАРА

Эту сортировку также называют быстрой сортировкой. Метод был разработан в 1962 году профессором Оксфордского университета К. Хоаром. Это прекрасный пример использования рекурсии. Рассмотрим принцип работы алгоритма при упорядочении массива A из N элементов по возрастанию.

Значение какого-нибудь элемента, обычно центрального, записывается в переменную X. Просматриваются элементы массива. При движении слева-направо ищем элемент больше или равный X. А при движении справа-налево ищем элемент меньше или равный X. Найденные элементы меняются местами и продолжается встречный поиск.

После этого массив окажется разделенным на две части. В первой находятся элементы меньше либо равные X, а справа - больше либо равные X. Можно заменить исходную задачу о сортировке массива A на две подзадачи о сортировке полученных частей массива.

Вычислительная сложность одного вызова данного рекурсивного алгоритма пропорциональна количеству элементов сортируемого фрагмента массива. В лучшем случае деление на части производится пополам, поэтому вычислительная сложность всего алгоритма быстрой сортировки составляет величину порядка N*LogN (логарифм по основанию 2). Вычислительная сложность в среднем того же порядка.

ПРИМЕР: Быстрая сортировка по возрастанию массива A из N целых чисел.

Рrogram Quick_Sort;

var A: array [1..100] of integer;

N, i : integer;

{В процедуру передаются левая и правая границы сортируемого фрагмента}

procedure QSort(L,R:integer);

Uses Crt;

var X, y, i, j: integer;

Вegin

CIrScr;

X:=A[(L+R) div 2];

i:=L; j:=R;

while i<=j do

begin

while A[i]<X do i:=i+1;

while A[j]>X do j:=j-1;

if i<=j then

begin

y:=A[i]; A[i]:=A[j]; A[j]:=y;

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

end;

end;

if L<j then QSort(L,j);

if i<R then QSort(i,R);

end;

begin

write('количество элементов массива ');

read(N);

for i:=1 to n do read(A[i]);

QSort(1,n); {упорядочить элементы с первого до n-го}

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

Функции

function имя функции(параметр 1 : тип 1;

параметр 2 : тип 2; раздел описаний функции

. . .

параметр n: типn) : тип функции;

begin

раздел операторов функции

имя функции := выражение;

end;

Программа вычисления факториала.

Programfactorial;

Uses Crt;

varn: integer;

Functionfact(n: integer): word;

Begin

If n=0 then fact:=1 else fact:=n*fuct(n-1);

End; {fact}

Begin

CIrScr;

writeln(‘Введите число, факториал которого вы хотите получить’);

readln(n);

ifn<0thenwriteln(‘Для отрицательного числа факториал не определён’)elsewriteln(‘Факториал ’,n, ‘равен: ’,fact(n));

readln;

End.

Решение биквадратного уравнения ax⁴+bx²+c=0.

Program largest_2;

Uses Crt;

var

a, b. с, d : Real;

function max2(x. у : Real.) : Real;

begin

if x > у then max2 := x else max2 := y;

end;

Begin

CIrScr;

write('Введите четыре числа:');

readln(a, b. с, d);

writeln('Большее из ‘, a:10:5, b;10;5, c;10;5, d:10;5, ‘ = ‘,max2(max2(a, b), max2(c,d));10;5;

readln;

End.

Программа вычисления площади n-угольника.

Рrogramarea;

UsesCrt;

constn= 4;

var

х, у : array[1..n] of Real;

i : Word;

su, pi : Real;

functionlength(nl, n2 : Word) : Real;

begin

length := Sqrt(sqr(x[nl] - x[n2]) + sqr(y[nl] - y[n2]))

end; {length}

procedurespace(nl, n2, n3 : Word; var pi : Real);

var

a, b, c, p: Real;

begin

a := length(nl, n2);

b := length(n2, n3);

с := length(nl, n3);

p:= (а +b+ с) / 2;

pi := Sqrt(p * (p - a) * (p - b) *(P - c));

end; {space}

Begin

Clrscr;

write('Введите координаты 1-й и 2-й вершин ');

readln(x[l] , у[1], х[2] , у[2]);

i := 2;

su := 0;

repeat

i := i + 1; {Подсчет вершин}

write('Введите координаты ', i, '-и вершины');

readln(x[i] , у[I]) ;

space(l, i - 1, i, pi);

su := su + pi;

until i = n;

writeln(‘Площадь = ', su:10:5);

readln;

End.

Составить программу перевода десятичного числа в двоичное.

Program perevod;

Uses Crt;

var a : longint;

function DEC_BIN(x:longint):string;

const digits:array [0..1] of char = ('0','1');

var res:string; d:0..1;

begin

res:='';

while (x<>0) do

begin

d:=x mod 2; res:=digits[d]+res;

x:=x div 2;

end;

DEC_BIN:=res;

end;

Вegin { основная программа }

CIrScr;

readln( a );

writeln( DEC_BIN(a) );

readln;

Еnd.

Составить программу перевода двоичного числа в десятичное.

Program perevod2;

Uses Crt;

var a : string;

function BINDEC(x: string): longint;

const digits: array [0..1] of char = ('0','1');

var res, ves: longint;

i, j: byte;

begin

res:=0; ves:=1;

for i:=length(x) downto 1 do begin

j:=0;

while (digits[j]<>x[i]) do inc(j);

res:=res+ves*j;

ves:=ves*2;

end;

BINDEC:= res;

end;

Вegin { основная программа }

CIrScr;

readln( a );

writeln( BINDEC(a) );

readln;

Еnd.

Программа перевода десятичного числа в шестнадцатеричное.

Program perevod3;

Uses Crt;

var a : longint;

function DECHEX(x:longint):string;

const digits:array [0..15] of char = ('0','1','2','3','4','5','6','7',

'8','9','A','B','C','D','E','F');

var res:string; d:0..15;

begin

res:='';

while (x<>0) do

begin

d:=x mod 16;

x:=x div 16;

res:=digits[d]+res;

end;

DECHEX:=res;

end;

Вegin { основная программа }

CIrScr;

readln( a );

writeln( DECHEX(a));

readln;

Еnd.

Программа перевода шестнадцатеричного числа в десятичное.

Program perevod4;

Uses Crt;

var a : string;

function HEXDEC(x: string): longint;

const digits: array [0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');

var res, ves: longint;

i, j: byte;

begin

res:=0; ves:=1;

for i:=length(x) downto 1 do

begin

j:=0; a[i]:=UpCase(a[i]);

while (digits[j]<>x[i]) do inc(j);

res:=res+ves*j;

ves:=ves*16;

end;

HEXDEC:= res;

end;

Вegin { основная программа }

CIrScr;

readln( a );

writeln( HEXDEC(a));

readln;

Еnd.

Рекурсивные алгоритмы: нахождения НОД и НОК двух чисел.

Program nodnok;

Uses Crt;

var a,b:longint;

function NOD(x, y: longint): longint; { фукнция поиска наиб. общ. делителя }

begin

if x<>0 then NOD:=NOD(y mod x, x) else NOD:=y;

end;

function NOK(x, y: longint): longint; { фукнция поиска наим. общ. кратного }

begin

NOK:=( x div NOD(x, y) ) * y;

end;

Вegin { основная программа }

CIrScr;

write(‘Введите два числа ’);

readln(a, b);

writeln( 'НОД этих чисел = ', NOD(a, b) );

writeln( 'НОК этих чисел = ', NOK(a, b));

readln;

Еnd.

Рекурсивные алгоритмы: вычисление факториал.

Program factorial;

Uses Crt;

var n: integer;

function f(x: integer): longint;

begin

if x = 1 then f := 1 else f := x * f(x-1);

end;

Вegin

CIrScr;

writeln('введите N (N=1..13)');

readln(n);

writeln('N!=',f(n));

readln;

Еnd.

Геометрические алгоритмы: Пересекаются ли 2 отрезка?

------------------------------------------------------------------------

Определяет пересечение отрезков A(ax1,ay1,ax2,ay2) и B (bx1,by1,bx2,by2),

функция возвращает TRUE - если отрезки пересекаются, а если пересекаются

в концах или вовсе не пересекаются, возвращается FALSE (ложь)

------------------------------------------------------------------------

Program line;

Uses Crt;

function Intersection(ax1,ay1,ax2,ay2,bx1,by1,bx2,by2:real):boolean;

var v1,v2,v3,v4:real;

begin

v1:=(bx2-bx1)*(ay1-by1)-(by2-by1)*(ax1-bx1);

v2:=(bx2-bx1)*(ay2-by1)-(by2-by1)*(ax2-bx1);

v3:=(ax2-ax1)*(by1-ay1)-(ay2-ay1)*(bx1-ax1);

v4:=(ax2-ax1)*(by2-ay1)-(ay2-ay1)*(bx2-ax1);

Intersection:=(v1*v2<0) and (v3*v4<0);

end;

Вegin { основная программа, вызов функции - тест }

CIrScr;

writeln(Intersection(1,1,5,5,1,2,3,1)); {test1, yes Intersection}

writeln(Intersection(1,1,5,5,1,2,1,3)); {test2, no Intersection}

readln;

Еnd.

Геометрические алгоритмы: Точка внутри сектора или нет?

------------------------------------------------------------------------

Если точка внутри сектора (или на сторонах) - TRUE, если нет - FALSE

tx,ty - вершина сектора

x1,y1,x2,y2 - точки на сторонах сектора

px,py - точка на плоскости

возвращает знак числа, 1 - положительное число, -1 - отрицательное, 0 - 0

------------------------------------------------------------------------

Program inter;

Uses Crt;

function sign(r:real):integer;

begin

sign:=0; if r=0 then exit;

if r<0 then sign:=-1 else sign:=1;

end;

function InsideSector(tx,ty,x1,y1,x2,y2,px,py:real): boolean;

var x,y,a1,a2,b1,b2,c1,c2:real;

var i1,i2,i3,i4:integer;

begin

x:=(tx+x1+x2)/3; y:=(ty+y1+y2)/3;

a1:=ty-y1; b1:=x1-tx; c1:=tx*y1-ty*x1;

a2:=ty-y2; b2:=x2-tx; c2:=tx*y2-ty*x2;

i1:=sign(a1*x+b1*y+c1); i2:=sign(a2*x+b2*y+b2);

i3:=sign(a1*px+b1*py+c1); i4:=sign(a2*px+b2*py+c2);

InsideSector:=((i1=i3) and (i2=i4)) or ((i1=0) and (i2=i4)) or ((i1=i3) and (i2=0));

end;

Вegin { основная программа, вызов функции - тест }

CIrScr;

writeln(InsideSector(1,1,5,1,1,5,3,3)); {test1, yes Inside}

writeln(InsideSector(1,1,5,1,7,2,3,3)); {test2, no Intersection}

readln;

Еnd.

Арифметические алгоритмы: возведение целого числа в натуральную степень.

Program chislo;

Uses Crt;

var x,y:integer;

function Degree(a,b:integer):longint;

var r:longint;

begin

r:=1;

while b>0 do

begin

r:=r*a;

b:=b-1;

end;

Degree:= r;

end;

Вegin

CIrScr;

writeln('введите число и (через пробел) степень числа');

readln(x,y);

writeln(Degree(x,y)); { print x^y }

readln;

Еnd.

Графика

Библиотека CRT

Библиотека (модуль) CRTсодержит константы, переменные, процедуры и функции, обеспечивающие управление текстовым режимом работы монитора и звуковым генератором.