Примеры программ с подпрограммами

Приведем примеры организации программ с подпрограммами.

Пример 4. Определить в матрице все элементы, которые являются числами Фибоначчи, и переписать их в одномерный массив. Полученный массив упорядочить по возрастанию.

Числа Фибоначчи образуются по следующему правилу: f₀=1, f₁=1, f_i =f_i-2 +f_i-1 (i≥2).

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

Проверку заданного числа на число Фибоначчи будем проводить путем последовательного сравнения этого числа со всеми числами Фибоначчи, начиная с 1. Процесс сравнения заканчивается в том случае, если заданное число оказалось числом Фибоначчи или если очередное число Фибоначчи превысило заданное число.

Для упорядочения чисел используется алгоритм “пузырьковой сортировки”.

program Procfib;

{$APPTYPE CONSOLE}

uses

SysUtils;

type

matr=array of array of Integer;

mas=array of Integer;

var

a:matr; b:mas;

m,n,i,j,k:Integer;

//Функция, определяющая, является ли заданное число

//числом Фибоначчи

function Fib(a:Integer):Boolean;

var

f0,f1,f2:Integer;

begin

Result:=False;

f1:=0;f2:=1;

repeat

f0:=f1;

f1:=f2;

f2:=f0+f1;

if a=f2 then Result:=True

until Result or(f2>=a);

end; //конец функции Fib

//Процедура упорядочения элементов одномерного массива

//по возрастанию

procedure Upor(var b:mas);

var

i,k,c,n:Integer;

pr:boolean;

begin

n:=High(b);

k:=0;

repeat

k:=k+1;

pr:=True;

for i:=0 to n-k do

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

begin

c:=b[i];

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

b[i+1]:=c;

pr:=False;

end;

until pr;

end; //конец процедуры Upor

//Процедура вывода элементов одномерного массива

procedure Wiwod(const b:mas);

var

i:Integer;

begin

for i:=0 to High(b) do

Write(b[i]:4);

WriteLn;

end; //конец процедуры Wiwod

begin //РАЗДЕЛ ОПЕРАТОРОВ

WriteLn('Введите количество строк и столбцов');

ReadLn(m,n);

SetLength(a,m,n);

Writeln('Введите матрицу по строкам');

for i:=0 to m-1 do

begin

for j:=0 to n-1 do

Read(a[i,j]);

ReadLn;

end;

WriteLn('Исходная матрица');

for i:=0 to m-1 do

begin

for j:=0 to n-1 do

Write(a[i,j]:4);

WriteLn;

end;

k:=0;

for i:=0 to m-1 do

for j:=0 to n-1 do

if Fib(a[i,j]) then

begin

k:=k+1;

SetLength(b,k);

b[k-1]:=a[i,j];

end;

if k=0 then

WriteLn('В матрице нет чисел Фибоначчи')

else

begin

WriteLn('Массив чисел Фибоначчи');

Wiwod(b);

Upor(b);

WriteLn('Упорядоченный массив чисел Фибоначчи');

Wiwod(b);

end;

ReadLn;

end.

Пример 5. Определить в каждой строке матрицы A(m,n), m<=10, n<=12, первое по порядку простое число и занести его в одномерный массив. Если в строке нет простых чисел, то для этой строки занести в массив нулевой элемент.

Поскольку максимальные размеры матрицы заданы в условии, то в программе целесообразно использовать статические массивы. Определение вида числа (простое или нет) произведем в подпрограмме-функции, которая возвращает значение “истина”, если число простое, и “ложь” в противном случае.

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

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

program funprost;

{$APPTYPE CONSOLE}

uses

SysUtils;

const

mm=10; nn=12;

type

matr=array[1..mm,1..nn] of Integer;

mas=array[1..mm] of Integer;

var

a:matr; i,j,m,n:Integer;

b:mas; pr:boolean;

function Pros(a:Integer):Boolean;

var

i:Integer;

begin

i:=2;

Result:=True;

while Result and (i<=Sqrt(a)) do

if a mod i=0 then

Result:=False

else

i:=i+1;

end; //конец функции Pros

begin //РАЗДЕЛ ОПЕРАТОРОВ ПРОГРАММЫ

WriteLn('Введите количество строк и столбцов матрицы');

ReadLn(m,n);

SetLength(a,m,n);

WriteLn('Введите матрицу по строкам');

for i:=1 to m do

begin

for j:=1 to n do

Read(a[i,j]);

ReadLn;

end;

for i:=1 to m do

begin

j:=1;

pr:=False;

while(j<=n) and not pr do

begin

pr:= Pros(a[i,j]);

if not pr then j:=j+1;

end;

if pr then b[i]:=a[i,j]

else b[i]:=0;

end;

WriteLn('Исходная матрица');

for i:=1 to m do

begin

for j:=1 to n do

Write(a[i,j]:4);

WriteLn;

end;

WriteLn('Полученный массив');

for i:=1 to m do

Write(b[i]:4);

ReadLn;

end.

Пример 6. Составить процедуру, которая в каждой строке матрицы заменяет каждый положительный элемент минимальным отрицательным элементом из стоящих между предыдущим и текущим положительными элементами. Если положительный элемент стоит на первом месте в строке, то его не изменять. Если отрицательных элементов нет между положительными, то замену не производить.

Использовать составленную процедуру для матрицы W(m,n),m<=12,n<=15.

В основной программе произведем ввод исходных данных (количества строк и столбцов матрицы и самой матрицы), с помощью процедуры преобразуем матрицу и осуществим вывод исходной и преобразованной матриц. Поскольку вывод необходимо выполнить два раза, то целесообразно организовать для этого процедуру.

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

program Proc_sam_pol;

{$APPTYPE CONSOLE}

uses

SysUtils;

const

mm=12;nn=15;

type

matr=array[1..mm,1..nn] of Real;

var

w:matr;

i,j,m,n:Integer;

procedure Wiwod(a:matr;m,n:Integer);

var

i,j:Integer;

begin

for i:=1 to m do

begin

for j:=1 to n do

Write(a[i,j]:6:1,' ');

WriteLn;

end;

end;

procedure Samen(var a:matr;m,n:Integer);

var

i,j,jpol,l:Integer;

Min:Real;

begin

for i:=1 to m do

begin

jpol:=0;

for j:=1 to n do

begin

if a[i,j]>0 then

begin

Min:=a[i,jpol+1];

for l:=jpol+1 to j-1 do

if a[i,l]<Min then Min:=a[i,l];

if Min<0 then a[i,j]:=Min;

jpol:=j;

end;

end;

end;

end;

begin //РАЗДЕЛ ОПЕРАТОРОВ ПРОГРАММЫ

WriteLn(Rus('Введите количество строк и столбцов матрицы'));

ReadLn(m,n);

WriteLn(Rus('Введите матрицу по строкам'));

for i:=1 to m do

begin

for j:=1 to n do

Read(w[i,j]);

ReadLn;

end;

WriteLn(Rus('Исходная матрица'));

Wiwod(w,m,n);

Samen(w,m,n);

WriteLn(Rus('Преобразованная матрица'));

Wiwod(w,m,n);

ReadLn;

end.

Дата добавления: 2015-07-26