Begin {начало основной программы} . . . Лабораторная работа 7.

Лабораторная работа 7.

Подпрограммы – процедуры.

Во введении в тему подпрограммы мы рассматривали блок схему подпрограммы с использованием подпрограмм – процедур:

Описание процедуры нахождения корней квадратного уравнения:

Procedure root(a,b,c:real; var:x1,x2:real); {заголовок процедуры, где root – имя

процедуры; a,b,c,х1,х2 – формальные параметры, используемые при написании

алгоритма вычисления корней. Затем следует алгоритм – тело процедуры.

(a,b,c – входные параметры, х1,х2 – выходные).}

begin... end; {тело процедуры.}

Begin {начало основной программы}...

Обращение к процедуре с фактическими параметрами a,b,c, получение

результатов х1,х2. root(a,b,c,x1,x2);

Обращение к процедуре с фактическими параметрами s,t,p, получение

результатов z1,z2. root(s,t,p,z1,z2);

Обращение к процедуре с фактическими параметрами k,n,m, получение

результатов y1,y2. root(k,n,m,y1,y2);

Рассмотрим как будет выглядеть соответствующая программа.

Напомним как решается квадратное уравнение в общем случае:

ax²+bx+c=0

Если а=0, то уравнение превращается в уравнение первой степени и корень один и он равен x=-c/b

Если a≠0, то уравнение второй степени. Дискриминант уравнения d = b²- 4ac

если d ≥0, то корня два и они действительные x₁ =-b- x₂ =-b+

если дискриминант d <0, то корня два и они комплексные

x₁ =- - * x₂ =- + *

На рисунке представлена сема алгоритма нахождения корней уравнения.

Составим программу решения следующей задачи:

Необходимо найти корни квадратного уравнения, согласно приведенного алгоритма. Количество уравнений не ограничено, поскольку программа должна спрашивать «будет ли ещё уравнение?». При написании программы используем подпрограмму – процедуру.

program Project_7_1_root; {$APPTYPE CONSOLE}

uses Math, SysUtils;

Label n,nah,kon;

Var lit:char; a,b,c,x,x1d,x2d,x1m,x2m:real; v:byte;

procedure Root(a,b,c:real; var x1d,x2d,x1m,x2m:real; var v:byte);

{После var указываются выходные параметры}

label k_proc; var d:real;

begin if a=0 then begin v:=1; x1d:=-c/b; goto k_proc; end else

d:=sqr(b)-4*a*c;

if d>=0 then begin v:=2; x1d:=(-b-sqrt(d))/(2*a); x2d:=(-b+sqrt(d))/(2*a); goto k_proc; end else

x1d:=-b/(2*a); x2d:=x1d; x1m:=-sqrt(-d)/(2*a); x2m:=sqrt(-d)/(2*a);

k_proc:end;

BEGIN n:writeln(' will there be another equation? input Y or y or N or n'); readln(lit);

if (lit='Y')or(lit='y') then goto nah else

if (lit='N')or(lit='n') then goto kon else writeln('invalid sumdol'); goto n;

nah:writeln('input a,b,c'); readln(a,b,c);

Root(a,b,c,x1d,x2d,x1m,x2m,v);

if v=1 then writeln('root is 1 - real, x=',x1d:6:2)else

if v=2 then writeln('root is 2 - real, x1=',x1d:6:2,' x2=',x2d:6:2)else

if x1m<0 then begin writeln('root is complex x1=',x1d:6:2,x1m:6:2,'*i ',

'x2=',x2d:6:2,'+',x2m:6:2,'*i'); goto n;end else

writeln('root is complex x1=',x1d:6:2,'+',x1m:6:2,'*i ',

'x2=',x2d:6:2,x2m:6:2,'*i'); goto n;

kon: END.

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

Количество массивов не ограничено, количество элементов массива произвольное, но не более 70.

program Project_7_2; {$APPTYPE CONSOLE}

uses SysUtils;

type mas=array[1..70]of real;

var n,k,i,no,kol,r,j:byte; a:mas; s:real; ch:char;

procedure prmas(n:byte; var s:real; var k,no:byte);

var i:byte; a:mas;

begin for i:=1 to n do begin

writeln('input ',i,' element array a'); readln(a[i]); end; {Введите i элемент массива а}

writeln; for i:=1 to n do write('a[',i,']=',a[i]:5:1,' ');

s:=0; k:=0; no:=0;

for i:=1 to n do begin

if a[i]>=0 then s:=s+a[i] else begin no:=i; k:=k+1; end; end; end;

BEGIN writeln('Specify the number of arrays'); readln(kol); {Введите количество массивов}

for j:=1 to kol do begin

writeln('Specify the dimensionality ’,j,’ of the array'); readln(r); {Задайте размерность j массива }

prmas(r,s,k,no); writeln;

writeln('The sum of positive elements =',s:6:1); {Сумма положительных элементов }

writeln('The last negative element has number =',no:2); {последний отриц. элем. имеет номер }

writeln('The number of negative items =',k:2);end; {Количество отрицательных элементов}

readln; END.

Локальные и глобальные описания объектов.

Мы уже знаем, что программа всегда блок, т.е. раздел операторов, снабжен­ный описаниями и имеющий заголовок. Вид блока-программы:

Program имя программы (возможны опции); {опции не обязательны} Label {раздел описания меток} Const...; {раздел описания констант} Туре {раздел определения типов} Var {раздел описания переменных}

Function...; Procedure {раздел описания функций и процедур} BEGIN... END. {раздел операторов}.

Функции и процедуры в свою очередь также являются блоками: Procedure имя (список входных формальных параметров); Var (список выходных формальных параметров); Label...; Const…; Type…; Var…; function…; procedure…; begin … раздел операторов…end;

Вложений блоков друг в друга может быть сколько угодно. (Имеется в виду функций и процедур).

Таким образом, программа всегда блок, в который могут быть вложены дру­гие блоки.

Как один из вариантов, возможна следующая структура программы:

Program prim; {начало блока 1}

Label N,M;
Const k=5.6;
Type d=array[1..10] of integer;
Var bx.real; i, j.integer; z,y:d;
function f(f_tb,c:réai):real; {начало блока2}
begin f:=…; end; {конец блока2}

procedure proc(f,b, с: real; var x,y,z:real); {начало блокаЗ}

Label K,L; var d,w,s:real;…

function fp(a,b:real):real; {начало блока4}

begin… fp:=; end; {тело fp, конец бл.4}

begin x:=…; y:=…; Z:=…; end; {тело proc, конец бл.З}

BEGIN b:=…; END. {тело основной программы,конец бл.1)

Таким образом, программа состоит из 4-х блоков. Все имена меток, кон­стант, типов, переменных, функций f и Ргос известны в блоке №1, поскольку они описаны в описании блока №1. Считантся, что они описаны здесь локально.

В блоке №2 - function описаний нет, поэтому своих собственных объектов этот блок не имеет. Формальные параметры не в счет, поскольку они служат только для описания алгоритма вычисления результата с именем f в функции f, а ячейки памяти для b,c,f здесь не выделяются.

Однако в этом блоке можно использовать все объекты, которые описаны в вышестоящем блоке, т.е. блоке 1, т.к. блок 2 является составляющей частью блока 1. Иногда говорят, что имена объектов блока 1 описаны для блока 2 глобально.

Аналогичная ситуация и с блоком 3 - Procedure Ргос. Для нее все объекты блока 1 являются глобальными, т.е. доступны. Кроме того, в блоке 3 имеются свои, описанные здесь объекты - метки K,L, переменные d,w,s, функция fp, ко­торые могут быть использованы только в блоке №3 и не известны в блоках №1 и№2.

Как следствие возможно применение одинаковых имен в различных блоках. Например см. имя d. В блоке 1 это тип массива. В блоке №3, в ргос имеется свое d, которое является собственным в блоке 3 и представляет собой не массив, а ячейку памяти типа real.

Варианты заданий для лабораторной работы следует брать как варианты заданий к лабораторрой работе 5 (массивы), но написать программу с следующими дополнениями:

---

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