K: end

END.

BEGIN

Begin

Begin

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}

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), повторить вопрос.

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

оформим в виде функции f1;

– в виде 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;

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;

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;

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

Описание процедуры:

Procedure имя (входные формальные параметры: тип;

Var выходные формальные параметры: тип);

описания (если они есть)

begin операторы

end;

Пусть необходимо найти корни квадратных уравнений

ax2+bx+c=0,

ky2+my+d=0,

sz2+tz+p=0,

где коэффициенты a, b, c вводятся по запросу. количество уравнений не ограничено. результаты вычислений выводить на экран (в основную программу не возвращать), см. рис. 2.1.

Program Prim33;

label K,NAH;

Var let:char; a,b,c:real;

procedure root(a,b,c:real); {процедура не имеет выходных параметров}

label K;

Var d,x1d,x1m,x2d,x2m:real;

Begin if a=0 then Begin

writeln('уравнение первой степени, корень один');

x1d:=-c/b; writeln('x=',x1d); goto K; end

else d:=b*b-4*a*c;

if d>=0 then Begin

writeln('уравнение второй степени, корни действительные');

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

x2d:=(-b+sqrt(d))/(2*a);

writeln('x1d=',x1d,' x2d=',x2d); goto K; end

else writeln('уравнение второй степени, корни комплексные');

x1d:=-b/(2*a); x2d:=x1d;

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

writeln('z1=',x1d,' ',x1m,' i;');

writeln('z2=',x2d,' ',x2m,' i;');

K: end;

BEGIN NAH: writeln('введите a,b,c'); readln(a,b,c); root(a,b,c);

writeln('будет еще уравнение? если "да", нажмите клавишу"Y"',

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

read(let);

if (let='Y') or (let='y') then goto nah else goto K;

Найти x, y, z — корни системы уравнений:

Как известно из линейной алгебры,

где

Раскрытие определителя

+

–

производится по схеме: т.е.

в процедуре a,b,c,d – входные данные, x,y,z – результаты.

Program Prim34;

label N,K;

Type w=array[1..3] of integer;

Var a,b,c,d:w; x,y,z:real; let:char;

function det(a:w;b:w;c:w):real;

Begin det:=a[1]*b[2]*c[3]+b[1]*c[2]*a[3]+c[1]*a[2]*b[3]

-c[1]*b[2]*a[3]-a[1]*c[2]*b[3]-b[1]*a[2]*c[3]; end;

procedure ur(a,b,c,d:w; Var x,y,z:real);

Var d0:real;

Begin d0:=det(a,b,c);

if d0=0 then Begin writeln('det=0 решения нет');

let:='0'; Exit; end else {EXIT – выход из процедуры}

x:=det(d,b,c)/d0;

y:=det(a,d,c)/d0;

z:=det(a,b,d)/d0; let:='1'; end;

BEGIN N: writeln('введите a1,b1,c1,d1'); readln(a[1],b[1],c[1],d[1]);

writeln('введите a2,b2,c2,d2'); readln(a[2],b[2],c[2],d[2]);

writeln('введите a3,b3,c3,d3'); readln(a[3],b[3],c[3],d[3]);

Дата добавления: 2014-12-17