p align="left"> 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), повторить вопрос. Прежде чем писать программу, определимся с функциями: оформим в виде функции 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; 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.
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; K: END. Найти 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]); ur(a,b,c,d,x,y,z); if let='0' then goto K else writeln(' / ',a[1],'x+',b[1],'y+',c[1],'z=',d[1]); writeln('система i ',a[2],'x+',b[2],'y+',c[2],'z=',d[2]); writeln(' \ ',a[3],'x+',b[3],'y+',c[3],'z=',d[3]); writeln('имеет решение: x=',x,' y=',y,' z=',z); K: writeln('Будет ещё ур-е? да - "Y" , нет - любая клавиша '); read(let); if (let='Y') or (let='y') then goto N; END. Имеется одномерный массив. Необходимо определить сумму положительных элементов, номер последнего отрицательного элемента, количество отрицательных элементов массива. Задача 1. Массив один и состоит из 7 элементов. Задача 2. Массивов два, размерность первого - 7 элементов, второго - 5. Задача 3. Количество массивов не ограничено, количество элементов в массивах произвольное, но не более 70. Program Prim35; { массив 1 и состоит из 7 элементов } label j; Type mas=array[1..7] of real; Var n,k,i,no:integer; a:mas; s:real; ch:char; procedure prmas(a:mas;n:integer; Var s:real; Var k,no:integer); Var i:integer; Begin s:=0; k:=0; no:=0; for i:=1 to n do Begin if a[i]>=0 then s:=s+a[i] else Begin k:=i; no:=no+1; end; end; end; BEGIN for i:=1 to 7 do Begin writeln('ввести значение a[',i,']'); readln(a[i]); end; prmas(a,7,s,k,no);
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22
|