Решение. Program Problem9; {Поиск среднего элемента массива}

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;

Program Problem12;

uses WinCrt;

const

n = 20;

type

t = array [1..n] of integer;

var

a: t;

max: integer;

{----------------------------------------------------------------------------------------}

Procedure create(n: integer; var a: t);

var

i: integer;

begin

randomize;

writeln('Заданный массив целых чисел');

for i: = 1 to n do

Begin

a[i]: = random(201) - 101;

write(a[i], ' ')

end;

writeln

end;

{----------------------------------------------------------------------------------------}

Procedure maximum(n: integer; a: t; var max: integer);

var

i: integer;

begin

max: = a[1];

for i: = 2 to n do if max < a[i] then max: = a[i]

end;

{----------------------------------------------------------------------------------------}

Begin

create(n, a);

maximum(n, a, max);

writeln('Наибольший элемент массива ', max)

end.

Способ

Program Problem12a; {Рекурсия}

uses WinCrt;

const

n = 20;

type

t = array [1..n] of integer;

var

a: t;

max: integer;

{----------------------------------------------------------------------------------------}

Procedure create(n: integer; var a: t);

var

i: integer;

begin

randomize;

writeln('Заданный массив целых чисел');

for i: = 1 to n do

Begin

a[i]: = random(201) - 101;

write(a[i], ' ')

end;

writeln

End;

{----------------------------------------------------------------------------------------}

Procedure maximum(n: integer; var max: integer);

label 1;

begin

if n = 0 then goto 1

else if a[n] > max then max: = a[n];

maximum(n - 1, max);

1: end;

{----------------------------------------------------------------------------------------}

Begin

create(n, a);

maximum(n, max);

writeln('Наибольший элемент массива ', max)

end.