![]() Главная страница Случайная страница КАТЕГОРИИ: АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника |
Решение. 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;
Задача 12. Найти максимальный элемент числового массива. Решение Способ 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.
|