Файл: Сборник-задач-на-Языке-Turbo-Pascal.doc

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;

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

flag : Boolean;

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

var d : Real;

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

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;