Алгоритм
Первоначально в
качестве границ - левой и правой берутся
значения 1 и n. Пусть p и q обозначают левую
и правую границы, тогда p := 1, а q := n; далее
производится деление и шаг за шагом
границы сближаются. Процесс деления
должен продолжаться до совпадения
границ, когда p = q (т. е. цикл выполняется
пока
Границы
сближаются следующим образом: пусть s
- номер среднего элемента, значение s -
это целая часть среднего арифметического
границ p и q
если
тогда надо
изменить прежнюю нижнюю границу на
а верхняя граница (q) остается без
изменения (выбирается правая часть
массива), иначе,
оставить без изменения нижнюю границу
(p), а верхнюю заменить на s
Теперь можно записать этот алгоритм в виде последовательности операторов:
p := 1; q := n;
while p < q do
begin
s := (p + q) div 2;
if a[s] < b then p := s + 1 else q := s
end;
Может случиться, что элемента массива, равного заданному числу b в массиве нет. Это обстоятельство надо учесть и добавить следующие операторы
if a[p] = b then writeln('Число ', b, ' входит в масс. и равно ', p, '-му элементу')
else writeln('Такого элемента в массиве нет')
Program Problem8;
uses WinCrt;
const
n = 20;
type
t = array[1..n] of integer;
var
a : t;
p, q, s, b, i : integer;
begin
writeln('Вводите элементы упорядоченного по неубыванию массива');
for i := 1 to n do
begin
write('Введите ', i, '-й элемент '); readln(a[i])
end;
writeln;
write('Введите число b '); readln(b);
p := 1; q := n;
while p < q do
begin
s := (p + q) div 2;
if a[s] < b then p := s + 1
else q := s
end;
if a[p ]= b
then writeln('Число ', b, ' равно ', p, '-му элементу')
else writeln('Такого элемента в массиве нет')
end.
Задача 9. Поиск "среднего" элемента массива
Решение
Program Problem9; {Поиск "среднего" элемента массива}
uses WinCrt;
const
n = 20;
type
t = array[1..n] of integer;
var
x : t;
m, i : integer;
{---------------------------------------------------------------------------------------}
Procedure create(n : integer; var x : t);
var
i : integer;
begin
randomize;
writeln('Заданный массив целых чисел');
for i := 1 to n do
begin
x[i] := random(201)-100;
write(x[i], ' ')
end;
writeln
end;
{----------------------------------------------------------------------------------------}
Procedure exchange(l, r : integer);
var
p : integer;
begin
p := x[l]; x[l] := x[r]; x[r] := p
end;
{----------------------------------------------------------------------------------------}
Procedure middle(k : integer; var x : t; var m : integer);
var
l, r : integer;
begin
l := 1; r := k;
repeat
while (x[l] <= x[r]) and (l < r) do r := r - 1;
exchange(l, r); {Процедура обмена}
while (x[l] <= x[r]) and (l < r) do l := l + 1;
exchange(l, r)
until l = r;
m := l
end;
{---------------------------------------------------------------------------------------}
begin
create(n, x);
middle(n, x, m);
write('Измененный массив со средним элементом ', x[m]);
writeln(' на ', m, '-ом месте');
for i := 1 to n do write(x[i], ' ');
writeln
end.
Задача 10. Составить программу, которая создает два массива чисел с помощью функции случайных чисел, упорядочивает их с помощью рекурсивной процедуры быстрой сортировки, а затем объединяет их в один упорядоченный массив, также с использованием рекурсивной процедуры.
Решение
Program Problem10;
uses WinCrt;
const
n = 10; m =15;
type
t = array[1..n] of integer;
u = array[1..m] of integer;
f = array[1..n+m] of integer;
var
a : t; b : u; c : f;
i, p, q : integer;
{----------------------------------------------------------------------------------------}
Procedure fast(q, p : integer; var a : t);
var
s, l, r : integer;
begin
l := q;
r := p;
s := a[l];
repeat
while (a[r] >= s) and (l < r) do r := r - 1;
a[l] := a[r];
while (a[l] <= s) and (l < r) do l := l + 1;
a[r] := a[l]
until l = r;
a[l] := s;
if q < l - 1 then fast(q, l - 1, a);
if l + 1 < p then fast(l + 1, p, a)
end;
{----------------------------------------------------------------------------------------}
Procedure fast1(q, p : integer; var b : u);
var
s, l, r : integer;
begin
l := q;
r := p;
s := b[l];
repeat
while (b[r] >= s) and (l < r) do r := r - 1;
b[l] := b[r];
while (b[l] <= s) and (l < r) do l := l + 1;
b[r] := b[l]
until l = r;
b[l] := s;
if q < l - 1 then fast1(q, l - 1, b);
if l + 1 < p then fast1(l + 1, p, b)
end;
{----------------------------------------------------------------------------------------}
Procedure new(n, m, q, p, k : integer; var c : f);
label 1, 2;
begin
if k = n + m + 1 then goto 1;
if p = n then begin q := q + 1; c[k] := b[q]; goto 2 end;
if q = m then begin p := p + 1; c[k] := a[p]; goto 2 end;
if a[p + 1] < b[q + 1]
then begin p := p + 1; c[k] := a[p]; goto 2 end
else begin q := q + 1; c[k] := b[q] end;
2: new(n, m, q, p, k + 1, c);
1: end;
{----------------------------------------------------------------------------------------}
begin
randomize;
for i := 1 to n do a[i] := random(201)-100;
for i := 1 to m do b[i] := random(201)-100;
fast(1, n, a);
writeln('Заданный упорядоченный 1-й массив');
for i := 1 to n do write(a[i], ' ');
writeln;
fast1(1, m, b);
writeln('Заданный упорядоченный 2-й массив');
for i := 1 to m do write(b[i], ' ');
writeln;
new(n, m, 0, 0, 1, c);
writeln('Новый упорядоченный объединенный массив');
for i:=1 to n + m do write(c[i], ' ');
writeln
end.
Задача 11. Рекурсивная процедура "быстрой" сортировки элементов массива.
Решение
Procedure fast(q, p : integer; var a : t);
var
s, l, r : integer;
begin
l := q; r := p;
s := a[l];
repeat
while (a[r] >= s) and (l < r) do r := r - 1;
a[l] := a[r];
while (a[l] <= s) and (l < r) do l := l + 1;
a[r] := a[l]
until l = r;
a[l] := s;
if q < l - 1 then fast(q, l - 1, a);
if l + 1 < p then fast(l + 1, p, a)
end;
Задача 12. Найти максимальный элемент числового массива.
Решение