2.2 Подпрограммы-функции, определенные пользователем

Функции пользователя описываются в разделе описания функций и процедур основной программы. Описание функции строится как законченная программа, т.е. может состоять из заголовка и шести разделов: описания, меток, констант, типов, переменных, функций и процедур и раздела операторов. Заканчивается описание функции символом точка с запятой.

Написать программу, вычисляющую с помощью подпрограммы-функции, выражение:

f1(x)=x+256.4; f2(y)=y+256.4; f3(z)=z+256.4;

Program Prim30;

Var

x,y,z,f1,f2,f3:real;

function f(x:real):real; {заголовок функции;}

{ f - имя функции, это же и имя}

{результата, х - формальный параметр}

Begin f:=(x+256.4); end; {тело функции}

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

writeln('ввести x,y,z');
readln(x,y,z);

f1:=f(x); {обращение к подпрограмме f с фактическим параметром x}

f2:=f(y); {обращение к подпрограмме f с фактическим параметром y}

f3:=f(z); {обращение к подпрограмме f с фактическим параметром z}

writeln(f1:20,f2:20,f3:20);
readln;
END.

Написать программу, вычисляющую G:

Оформим вычисления в виде подпрограммы-функции:

Program Prim31;

Var h,x,y,z,g:real;

function f(a,b:real):real; {входные формальные параметры a,b}

Begin

f:=sqr(ln(a)+sin(b))/(cos(a)*exp(b));

end;

BEGIN writeln ('введите полжительные h,x,y,z');

readln(h,x,y,z);

if (x>=1) and (x<3) then
writeln('g=',h+f(x,y))
else;

if (x>=3) and (x<5) then
writeln('g=',sqrt(h)+f(z,x))
else;

if (x>=5) and (x<=9) then
writeln('g=',sqr(h)+f(y,z))
else;

writeln('g=0');

readln; END.

В этой программе описание формулы начинается словом function, имя функции f, результат вычисления функции типа real. Тело функции заключено в операторные скобки begin, end; a, b называются формальными параметрами. В данной функции нам не понадобились разделы описаний.

При выполнении основной программы, которая начинается begin, встречается выражение f(x, y). Встретив такое выражение, машина по имени f определяет, что это обращение к функции. затем машина проверяет совпадение количества и типа фактических параметров (x, y) с формальными (a, b). При их совпадении в тело функции вместо формальных параметров подставляются фактические и тело выполняется, полученный результат используется при вычислении выражения, стоящего в операторе writeln.

Составить программу вычисления при условии, что а<b:

Если a и b не укладываются в заданные пределы, нужно сообщить об этом пользователю и спросить, будут ли другие диапазоны -- ответ: "Y, N". Если заданы не те буквы (y, n), повторить вопрос.

Прежде чем писать программу, определимся с функциями:

exp(x/10)+sqrt(x/(x+3)) - оформим в виде функции f1;

sqrt(sqr(x)/(3*x+10)) - в виде f2;

sin(x)+f1 - в виде f3;

cos(x)+f1 - в виде f4;

cos(x)-f2 - в виде f5;

вычисления по методу трапеций с точностью 0.1 oформим в виде подпрограммы-функции f6.

Program Prim32;
label NAH,P;

Var
b,a,z:real;

lit:char;

function f1(x:real):real;

Begin
f1:=exp(x/10)+sqrt(x/(x+3));
end;

function f2(x:real):real;

Begin
f2:=sqrt(sqr(x)/(3*x+10));
end;

function f3(x:real):real;

Begin
f3:=sin(x)+f1(x);
end;

function f4(x:real):real;

Begin
f4:=cos(x)+f1(x);
end;

function f5(x:real):real;

Begin
f5:=cos(x)-f2(x);
end;

function f6(a,b:real):real;

label K,N1,K1,KC,T;

Var
h,s1,s,x:real; i,n:integer;

Begin

s1:=9.999e+10;
n:=10;

N1: h:=(b-a)/n;
s:=0;
x:=a;

for i:=1 to n do

Begin
if a>b then
goto t else

if (0<=a)and(b<5) then
Begin
s:=s+(f3(x)+f3(x+h))/2*h;

goto kc;
end else

if (5<=a)and(b<10) then
Begin
s:=s+(f4(x)+f4(x+h))/2*h;

goto kc;
end
else

if (10<=a)and(b<=16) then
Begin
s:=s+(f5(x)+f5(x+h))/2*h;

goto kc;
end
else goto t;

KC: x:=x+h;
end;

if abs(s-s1)<0.1 then
goto k

else
Begin
s1:=s;
n:=n*10;
goto n1;
end;

K: f6:=s;
goto k1;

T: writeln('пределы интегрирования не соответствуют условию');

f6:=-9999999999.;

K1: end;

BEGIN

NAH: writeln('введите значения a,b');

readln(a,b);
z:=f6(a,b);

if z=-9999999999. then
goto p;

writeln('z=',z);

P: readln;

writeln(' будем еще вычислять z ? , если "да" ',

'то нажмите клавишу "y" , если нет, то любую клавишу ');

readln(lit);

if (lit='Y') or (lit='y') then
goto NAH;

END.