Function <имя> (Формальные параметры):<тип результата>;
<описательная часть>
Begin
<операторы>
end ;
В разделе операторов должен находиться, по крайней мере, один оператор, присваивающий имени функции значение. В точку вызова возвращается результат последнего присваивания.
Пример 1. Даны три одномерных массива. Найти наибольший элемент в каждом из массивов с помощью одной процедуры.
program abc;
uses crt;
type
vector=array [1..200] of real;
var
a,b,с:vector;
i,k:integer;
max:real;
nmax:integer;
procedure max1(x:vector; L:integer; var rmax:real; var n:integer);
var j:integer;
begin
rmax:=x[1]; n:=1;
for j:=2 to L do
if x[j]>rmax then
begin
rmax:=x[j]; n:=j ;
end
end;
begin clrscr;
writeln ('введите размер массивов');
read (k);
for i:=1 to к do
begin
write ('а[',i,']='); read (a[i]);
end;
max1(а, к, max, nmax);
writeln('max=',max:1:4,' nmax=',nmax);
for i:=1 to к do
begin
write (‘b[' ,i, '] = '); read (b[i]);
end;
Max1(b, k, max, nmax) ;
writeln (' max=',max:1:4,' nmax=',nmax);
for i:=l to к do
begin
write('c[',i,']='); read(c[i]);
end ;
maxl(с, k, max, nmax);
writeln (' max=',max:1:4,' nmax=',nmax);
end.
Пример 2. Написать функцию, вычисляющую тангенс вещественного числа.
program abc;
uses crt;
var
x,y:real;
function tan (с:real):real;
begin
tan:=sin(c)/cos(c);
end;
begin
read (x,y);
writeln ('tg(',x:l:3,')=',tan(x):l:4);
writeln (‘tg(’,y:l:3,')=',tan(y):l:4);
end.
Пример 3. Написать программу решения группы квадратных уравнений
, где p¸q¸r – массивы вещественных чисел, состоящие из k элементов. Решение одного уравнения оформить в виде процедуры.
program uravnenie;
uses crt;
var p,q,r : array[1..50] of real;
x,y : real;
i,k : integer;
L : boolean;
procedure korni( a,b,c:real; var x1,x2:real; var pr : boolean);
var d : real;
begin
d:=b*b-4*a*c;
if d>=0 then
begin
pr:=true;
x1:=(-b+sqrt(d))/2/a;
x2:=)-b-sqrt(d))/2/a
end
else pr:=false
end;
begin clrscr; randomize;
write(' vvedite kolichestvo uravnenii');
read(k);
for i:=1 to k do
begin
p[i]:=5*random;
q[i]:=10*random;
r[i]:=7*random;
korni(p[i],q[i],r[i],x,y,L);
if L then writeln('korni',i,' uravnenij',' x1=',x:8:5,' x2=',y:8:5)
else writeln(' v',i, ' uravntnii kornej net')
end
end.
Пример 4. Вычислить выражение , в котором возведение в степень выполняется функцией Step.
program primer;
uses crt;
var m : integer;
a,z,r : real;
function step(n : integer; x : real): real;
var i : integer;
y : real;
begin
y:=1;
for i:=1 to n do
y:=y*x;
step:=y;
end;
begin
write(‘vvedite a,m=’);
read(a,m);
z:=step(5,a);
z:=z+step(3,1/a);
if m=0 then r:=1;
if m<>0 then r:=step(m,a);
z:=z/(2*r);
writeln(‘ pri a=’,a,’ m=’,m,’ z=’,z)
end.
Пример 5. Переписать отрицательные элементы массивов X(N) и Y(M) в массив Z подряд.
program SORT;
uses crt;
const n=200;
type mas=array[1..n] of real;
var x,y,z : mas;
i,n,m,k,l : integer;
procedure st(a : mas; nn :integer; var c : mas; var k,L : integer);