Вычисление суммы. Вычисление элементов последовательности

1. Задание

а)
Задание
0,2 0,5
e 3 8,2 ;
sin 0,3 cos 0,3
1
3
б) (2 x 2 3) sin x e x
3 1
, x 1,2 ;
в) Aj 1 j 2 Aj ( j 1) Aj 1 , A0 1, A1 1,
j=1,2,3,4,5;
г) Составить логическое выражение, принимающее значение
истина, если точка с координатами (x,y) попадает в треугольник с
координатами вершин {[0;0];[0;1];[2;1]}. Вычислить значения
выражения для следующих координат точек:
{[0,5;0,7], [1;0], [-0,5;0,5], [1;1,5]}.
Тесты:
а) ожидаемый результат 1,346;
б) ожидаемый результат для x=1,2 равен 20,783;
в) ожидаемый результат A0=1, A1=1, A2=1, A3=5, A4=47, A5=747,
A6=19363;
г) ожидаемый результат TRUE для x=0,5, y=0,7, а для точек с
координатами {[1;0],[-0,5;0,5], [1;1,5]} ожидаемый результат FALSE.

2. Программа

{ Автор: Иванов И. И. }
{ Группа: ФФ-101 }
{ Тема: Простейшие программы }
program Ex1;
var
X,Y,X1,Res : real;
L : boolean;
A0,A1,A2,A3,A4,A5,A6 : integer;
begin
res:=(0.2+sqrt(0.5))/(sin(0.3)+cos(0.3))exp(1/3)+exp(1/3*ln(8.2));
writeln('Результат "а" =',res:10:3);
write('Ввод x=');
readln(X1);
res:=(2*sqr(X1)+3)*sin(X1)+exp(X1*X1*X1+1);
writeln(‘ Результат "б" =',res:10:3);
A0:=1;
A1:=1;
A2:=A1;
A3:=4*A2+A1;
A4:=9*A3+2*A2;
A5:=16*A4+3*A3;
A6:=25*A5+4*A4;
writeln(' A0=',A0,' A1=',A1,
' A2=',A2,' A3=',A3,' A4=',A4,
' A5=',A5, ' A6=', A6);
write('Ввести X и Y');
readln(X,Y);
L:=(X>=0) and (Y<=1) and (Y>=0.5*X);
writeln(' L=',L)
end.

3.

Пример 2.
Составить программу, вычисляющую
значение следующей функции:
x 2 , x 0,
y ( x)
x, x 0.
-
+
x>=0
y:=-x
y:=x2
program Ex2;
var
x:real;
y:real;
begin
writeln('Ввод x');
readln(x);
if x>=0 then
y:=sqr(x)
else
y:=-x;
writeln('F =',y:10:2)
end.

4.

Пример 3.
Составить программу, вычисляющую
значение следующей функции:
xy,
x y,
p ( x, y )
x y,
1,
x 0, y 0;
x 0, y 0;
x 0, y 0;
x 0, y 0;
-
+
x>=0
-
+
-
y>=0
p:=1
+
y>=0
p:=x-y
p:=x+y
p:=x*y
program Ex3;
var
x,y : real;
p : real;
begin
writeln('Ввод X,Y');
readln(x,y);
if x>=0 then
if y>=0 then
p:=x * y
else
p:=x + y
else
if y>=0 then
p:=x - y
else
p:=1;
writeln('P =',p:10:2);
end.

5.

Пример 4.
program Ex4;
Составить программу, печатающую var
X,Y: real;
значения 30, 20, 10 если точка с
N : integer;
координатами (x,y) находится на
расстоянии меньше 1, 2, 3 от begin
начала координат соответственно и
writeln('Ввод X,Y');
0 в остальных случаях.
readln(X,Y);
case trunc(sqrt(sqr(X)+sqr(Y))) of
L trunc x 2 y 2
0: N:=30;
1: N:=20;
L
2: N:=10;
else
0
1
2
else
N:=0
end;
N:=30
N:=20 … N:=10
N:=0
writeln('N =',N);
end.

6. Вычисление суммы

Вычислить сумму элементов множества {ai|i=1..N}. Для вычисления
суммы n элементов следует прибавить элемент an к сумме n-1-го
элемента.
S n S n 1 an ;
S 0 0.
Пример 6.
Составить программу вычисления
суммы:
n2
S ( 1)
,
1 n
n 1
10
n
элемент суммы
n2
an ( 1)
,
1 n
n
для вычисления (– 1) используем
соотношение
( 1) n ( 1)( 1) n 1 ( 1) n 1.
program Ex6;
var
S,a: real;
N,Z: integer;
begin
S:=0;
Z:=-1;
for N:=1 to 10 do begin
a:=Z*sqr(N)/(1+N)
S:=S + a;
Z:=- Z
end;
writeln(' S1= ',S:10:3);
end.

7. Вычисление бесконечной суммы

Пример 7.
Вычислить сумму
( 1)i x i
( 1)i x i
.
S
, обозначим ai
i!
i!
i 1
Суммирование прекращается при ai .
Выведем рекуррентную формулу для ai.
( 1)i x i
( 1)i 1 x i 1
ai
, ai 1
.
i!
i 1 !
ai
( 1)i x i (i 1)!
x(i 1)(i 2)...2 1
x
.
i 1 i 1
ai 1
( 1) x i!
i (i 1)(i 2)...2 1
i
x
i
Имеем: ai ai 1 ,
Проверка:
a1 x,
a1 x.
2
x
x x
a2 a1 x .
2
2 2
( 1) 2 x 2 x 2
( 1)1 x1
.
a1
x , a2
2!
2
1!
Program Ex7;
var
x,s,a,E: real;
i: integer;
begin
write(' Ввод X= ');
readln (x, E);
s:=0;
a:=-x;
i:=1;
while abs(a)>E do begin
s:=s + a;
i:=i+1;
a:= - a*x/i
end;
writeln(' S2= ',s:10:3);
end.

8. Вычисление элементов последовательности

Пример 8.
Вычислить наименьший номер
элемента
последовательности,
заданной рекуррентной формулой:
An 1 An An 1 , A0 1, A1 2,
для которого выполняется условие:
An 100.
Таблица трассировки
N
A0
A1
A2
2
1
2
3
3
2
3
5
4
3
5
8
5
5
8
13
6
8
13
21
7
13
21
34
8
21
34
55
9
34
55
89
10
55
89
144
Program Ex8;
var
A0,A1,A2: real;
N: integer;
begin
A1:=1;
A2:=2;
N:=1;
repeat
N:=N+1;
A0:=A1;
A1:=A2;
A2:=A1+A0;
until A2>100;
writeln(' Nmin= ',N);
end.

9. Определение максимального (минимального) элемента множества

Пример 9.
Определить номер максимального
элемента множества {ai | i=1..30},
где
i
2 10
ai i e
.
Рекуррентные соотношения:
max ai max ak , max ai ,
1 i k
1 i k 1
max a1 a1.
В
качестве начального значения переменной,
предназначенной для хранения текущего значения
максимального (минимального) элемента, следует
использовать один из элементов множества.
program Ex9;
var
i, Imax: integer;
a, Amax: real;
begin
Amax:=exp(-0.1);
Imax:=1;
for i:=2 to 30 do begin
a:=sqr(i)*exp(-i/10);
if a>Amax then begin
Amax:=a;
Imax:=i
end
end;
writeln('Amax= ',Amax:10:2,‘
Imax= ',Imax:3);
end.

10.

Пример 11.
Составить
программу,
выполняющую
поиск
целочисленных решений
уравнения
x2 y 2 z 2 0
в интервале значений
каждой переменной от 1
до 10.
program Ex10;
var
x,y,z: integer;
begin
for x:=1 to 9 do
for y:=x+1 to 10 do
for z:=1 to 10 do
if x*x+y*y=z*z then
writeln('x= ',x:3,' y= ',y:3,' z= ',z:3);
end.
При организации цикла учитывалось, что
переменные x и y входят в уравнение
симметрично, поэтому рассматривались
только решения, в которых x<y.

11. Пример использования вспомогательных процедур для управления циклами

program Ex11;
var
i: integer;
begin
for i:=1 to 10 do begin
if i=5 then
continue;
if i=7 then
break;
writeln(i)
end;
writeln(i)
end.

12.

Пример 12.
Числовая последовательность определена рекуррентной
формулой:
Ai 1
2i 1 Ai 1
; A1 1,2 ; A2 2,3.
Ai
i
Составить подпрограмму, вычисляющую значение элемента
последовательности для произвольного заданного номера этого
элемента.

13. Программа для примера 12

program Ex12;
function A (n: integer): real;
var
A1,A2,A3: real;
i: integer;
begin
A2:=1.2;
A3:=2.3;
case n of
1: A:=A2;
2: A:=A3
else begin
for i:=2 to n-1 do begin
A1:=A2;
A2:=A3;
A3:=(2*i+1)/A2-A1/i
end;
A:=A3
end
end
end;
var
An: real;
N: integer;
begin
write ('N= ');
readln (N);
An:=A(N);
writeln('An=',An)
end.
Ai 1
2i 1 Ai 1
; A1 1,2 ; A2 2,3.
Ai
i

14.

Пример 13.
Составить процедуру, определяющую максимальное,
минимальное и среднее арифметическое значения
элементов множества G={gi |i = 0..22}, где
g i 0,18i 3 4,9i 2 20i .

15. Программа для примера 13

program Ex13;
procedure SetG(var Gmin,Gmax,Gavg:real);
var
Gi:real;
i:integer;
begin
Gmin:=0;
{g0 =0}
Gmax:=0;
Gavg:=0;
for i:=1 to 22 do begin
Gi:=0.18*i*i*i-4.9*i*i+20*i;
Gavg:=Gavg+Gi;
if Gi>Gmax then
Gmax:=Gi
else
if Gi<Gmin then
Gmin:=Gi
end;
Gavg:=Gavg/23
end;
var
Gmin,Gmax,Gavg:real;
begin
SetG(Gmin,Gmax,Gavg);
writeln(' Min=',Gmin:6:2,
' Max=',Gmax:6:2,
' Avg=',Gavg:6:2)
end .

16. Пример 14. Вложенные подпрограммы

program Ex14;
procedure Outer;
procedure Inner;
begin
writeln('Inner');
end;
begin
writeln('Outer');
Inner;
end;
begin
Outer
end.
Внутренняя
процедура
Внешняя
процедура

17. Пример 15. Использование подпрограмм в качестве параметров.

Составить
программу,
которая
вычисляет
и
распечатывает в виде таблицы значения заданных
функций:
F1( x) sin( x) / x, F 2( y) y 2 2 y y , F 3( z ) ( z 2)( z 1) z.
Вычисление заданных функций и построение таблицы
следует реализовать в виде подпрограмм.
Вычислить значение выражения:
F1( x) F 2( y ) F 3( F 2( z ))
Для заданных значений x, y и z.

18. Программа для примера 15

program Ex15;
type
TFunc=function (x:real):real;
function F1(x:real):real; far;
begin
if x=0 then
F1:=1
else
F1:=sin(x)/x
end;
function F2(y:real):real; far;
begin
F2:=sqr(y)+2*y*sqrt(y)
end;
function F3(z:real):real; far;
begin
F3:=(z+2)*(z+1)*z
end;
procedure Table(F:TFunc);
var
i:integer;
r,x:real;
begin
writeln('----------------');
writeln('I
I
I');
writeln('I X I F(x) I');
writeln('I
I
I');
writeln('----------------');
for i:=0 to 10 do begin
x:=0.1*i;
r:=F(x);
writeln('I ',x:3:1,' I ',r:6:3,' I')
end;
writeln
end;

19. Продолжение программы для примера 15

var
x,y,z: real;
R: real;
begin
writeln(' Ввод x,y,z');
readln(x,y,z);
Table(F1);
Table(F2);
Table(F3);
R:=F1(x)+F2(y)*F3(F2(z));
writeln(' Результат ',R:8:4);
end.

20. Пример 16. Вычисление n!, используя соотношения n!=(n-1)!*n, 0!=1.

Program Ex16;
function Nf(N: integer): integer;
begin
if N>0 then
Nf:=Nf(N-1)*N
else
Nf:=1;
end;
Прямой ход
var
Номер вызова
NN,N: integer;
1
2
3
begin
readln(N);
NN:=Nf(N);
Nf(1)
writeln(NN);
N=1
end.
Nf(2)
Nf(2)
Nf(3),
N=3
Обратный ход
Номер вызова
4
4
3
2
1
Nf(0)=1
N=0
Nf(1)
N=1
Nf(1)=1*1
Nf(2)
Nf(2)=1*2
Nf(3)
Nf(3)
N=2
N=2
Nf(2)
N=2
Nf(3)
N=3
Nf(3)
N=3
Nf(3)
N=3
Nf(3)=2*3
Nf=6

21.

Пример 17.
Составить программу,
определяющую номер
максимального элемента в
заданном множестве
действительных чисел.
В программе предполагается,
что массив NumSet может
содержать до ста элементов.
Реальное число элементов
множества вводится с
клавиатуры и присваивается
переменной N.
Значение максимального
элемента сохраняется в
переменной MaxReal, а
соответствующий номер - в
переменной NumOfMax.
Program Ex17;
type
TNumArray=array [1..100] of real;
var
NumSet:TNumArray;
MaxReal: real;
NumOfMax,i,N : integer;
begin
write('N= ');
readln(N);
for i:=1 to N do
readln(NumSet[i]);
MaxReal:=NumSet[1];
NumOfMax:=1;
for i:=2 to N do
if NumSet[i]>MaxReal then begin
MaxReal:=NumSet[i];
NumOfMax:=i;
end;
writeln(NumOfMax:3,MaxReal:10:3)
end.

22.

Пример 18.
Составить
программу,
вычисляющую
произведение
двух
квадратных матриц С=A×B, где N – порядок матрицы, а элементы
cij определяются по формуле:
N
cij aik bkj
k 1
Для хранения матриц в памяти используются двумерные массивы.
В программе предполагается, что число элементов матрицы не
превышает 100. Текущий размер матрицы сохраняется в качестве
значения переменной N. Исходные матрицы размещаются в
массивах A и B, а их произведение в массиве С.
Ввод значений элементов исходных матриц выполняется по
строкам.

23.

Program Ex18;
type
TMatrix=array [1..10,1..10] of integer;
procedure Input (N: integer; var X:TMatrix);
var
i,j: integer;
begin
for i:=1 to N do begin
for j:=1 to N do
read(X[i,j]);
readln;
end;
end;
var
A,B,C: TMatrix;
i,j,k: integer;
N: integer;
begin
write(' N= ');
readln(N);
Input(N,A);
Input(N,B);
for i:=1 to N do
for j:=1 to N do begin
C[i,j]:=0;
for k:=1 to N do
C[i,j]:=C[i,j]+A[i,k]*B[k,j];
end;
for i:=1 to N do begin
for j:=1 to N do
write(C[i,j]:3);
writeln;
end;
end.

24. Пример 19.Линейный поиск

program Ex19;
type
TArN=array [1..5] of integer;
procedure LSearch(A:TArN; N: integer; x: integer; var Num: integer);
begin
Num:=1;
while (Num<=N) and (x<>A[Num]) do
Num:=Num+1;
if Num>N then
writeln(' Элемент отсутствует')
end;

25. Пример 19. Двоичный поиск

procedure DSearch(A:TArN; N: integer; x: integer;var Num: integer);
var L,R,M : integer;
begin
L:=1;
R:=N;
while L<R do begin
M:=(L+R) div 2;
if x>A[M] then
L:=M+1
else
R:=M
end;
if A[R]<>X then
writeln(' Элемент отсутствует')
end;

26. Пример 19. Главная программа

const
ArN:TArN=(1,9,5,4,6);
N=5;
var
Num,x:integer;
begin
readln(x);
LSearch(ArN,N,x,Num);
writeln(Num);
DSearch(ArN,N,x,Num);
writeln(Num);
end.

27.

Пример 20. Пузырьковая сортировка.
Программа рассчитана на
худший случай, когда
минимальный элемент
находится в конце
последовательности и
учитывает, что максимальный
элемент перемещается в
требуемое место за один
проход.
program Ex20;
type
ArN = array [1..10] of integer;
const
A : ArN =(20,15,6,17,4,1,-5,3,9,0);
var
C, i, j : integer;
begin
for i:=1 to 9 do
for j:=1 to 10-i do
if A[j]>A[j+1] then begin
C:=A[j];
A[j]:=A[j+1];
A[j+1]:=C
end;
for i:=1 to 10 do
write(' ',A[i]);
writeln;
end.

28.

Пример 21. Быстрая сортировка
program Ex21;
type
TNumAr = array[1..10] of integer;
procedure QuickSort (var A: TNumAr;
N:integer);
procedure Sort(l,r: integer);
var
i, j ,x, y : integer;
begin
i:=l; j:=r;
x:=a[(l+r) div 2];
repeat
while a[i]<x do i:=i+1;
while x<a[j] do j:=j-1;
if i<=j then begin
y:=a[i]; a[i]:=a[j]; a[j]:=y;
i:=i+1; j:=j-1;
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
begin {quicksort};
sort(1,N);
end;
const
a:TNumAr=(20,15,6,17,4,1,-5,3,9,0);
var
i: integer;
begin
quicksort(A,10);
for i:=1 to 10 do write(A[i]:4);
writeln;
end .

29.

Пример 22.
Подсчитать количество символов "А" в строке, которая вводится с
клавиатуры и присваивается в качестве значения переменной s.
program Ex22;
var
s : string;
i,k: integer;
begin
readln(s);
k:=0;
for i:=1 to Length(s) do
if s[i]='A' then
k:=k+1;
writeln(k)
end.

30.

Пример 23.
Составить программу, проверяющую, имеется ли в
заданном тексте баланс открывающих и закрывающих
круглых скобок, т. е. верно ли, что:
а) открывающая скобка всегда предшествует
соответствующей закрывающей;
б) первый и последний символы текста – пара
соответствующих друг другу скобок.

31. Пример 23. Программа

if ( s[1]='(' ) and ( s [Len]=') ' ) then begin
program Ex23;
while (i<Len-1) and (k>=0) do begin
var
i:=i+1;
s: string;
if s [ i ]='(' then
i,k,Len: integer;
k:=k+1
l: boolean;
else
begin
if s [ i ]=')' then
writeln('Ввод строки');
k:=k-1;
readln(s);
end;
Len:=Length(s);
L:=i=Len;
k:=0;
end
else
i:=1;
L:=false;
writeln('Баланс скобок ',L);
end.

32.

Пример 24.
Задано множество попарно различных точек на
плоскости.
Найти
пару
точек,
принадлежащих
множеству, с минимальным расстоянием между ними.
Вывести на печать значение расстояния и номера
первой найденной пары точек.

33. Пример 24. Программа (начало)

Program Ex24;
const
N=5;
type
TPoint=record
X,Y:real
end;
TPointsSet=array [1..5] of TPoint;
const
PointsSet:TPointsSet=((X:0;Y:0),(X:0;Y:2),
(X:1;Y:1), (X:4;Y:2), (X:2;Y:4));
function Dist(X1,Y1,X2,Y2:real):real;
begin
Dist:=sqrt(sqr(X1-X2)+sqr(Y1-Y2));
end;

34. Пример 24. Программа (продолжение)

procedure MinDist(var P:TPointsSet; var IMin, JMin: integer; var SMin:
real);
var
I,J:integer;
D:real;
begin
SMin:=Dist(P[1].X,P[1].Y,P[2].X,P[2].Y);
IMin:=1;
JMin:=2;
for I:=1 to N-1 do
for J:=I+1 to N do begin
D:=Dist(P[I].X,P[I].Y,P[J].X,P[J].Y);
if D<SMin then begin
SMin:=D;
IMin:=I;
JMin:=J;
end
end
end;

35. Пример 24. Программа (окончание)

var
IMin,JMin: integer;
SMin: real;
begin
MinDist(PointsSet,IMin, JMin,SMin);
writeln(IMin:3,' ',JMin:3, ' ',SMin:7:2);
end.

36.

Пример 25
Заданы таблицы СОТРУДНИКИ и ОТДЕЛЫ. Составить программу,
определяющую распечатывающую таблицу, которая содержит список
сотрудников, работающих в заданном отделе.
Таблицы СОТРУДНИКИ и ОТДЕЛЫ содержат сведения о сотрудниках
некоторой организации и отделах, в которых они работают. Таблицы
связаны с помощью поля НОМЕР_ОТД.
НОМЕР_СОТР - уникальный номер сотрудника (целое без знака).
ФАМИЛИЯ - фамилия сотрудника (строка из 15 символов).
ЗАРПЛАТА - зарплата сотрудника (вещественное).
НОМЕР _ОТД - уникальный номер отдела (целое без знака).
НАЗВАНИЕ- название отдела (строка из 12 символов).
СОТРУДНИКИ
НОМЕР_СОТР ФАМИЛИЯ ЗАРПЛАТА
ОТДЕЛЫ
НОМЕР_ОТД
НОМЕР_ОТД НАЗВАНИЕ
1020
Иванов
11500.03
300
300
Бухгалтерия
1232
Петров
12321.20
301
301
Канцелярия
…
…
…
…
…
…

37. Пример 25. Программа (начало)

Program Ex25;
const
NE=5; ND=3;
type
TStr15=string[15];
TStr12=string[12];
TEmp=record
ENum :integer;
EName:TStr15;
ESal :real;
DNum :integer;
end;
TDept=record
DNum :integer;
DName:TStr12;
end;
TEmpTable=array [1..NE] of TEmp;
TDeptTable=array [1..ND] of TDept;

38. Пример 25. Программа (продолжение)

const
Emp:TEmpTable=
((ENum:21; EName:'Иванов'; ESal:10300.0; DNum:102),
(ENum:12; EName:'Орлов'; ESal:6300.0; DNum:300),
(ENum:35; EName:'Сидоров'; ESal:12340.5; DNum:200),
(ENum:14; EName:'Лебедев'; ESal:6780.9; DNum:300),
(ENum:51; EName:'Гусев';
ESal:10110.1; DNum:300));
Dept:TDeptTable=((DNum:102;DName:'Бухгалтерия'),
(DNum:300;DName:'Канцелярия' ),
(DNum:200;DName:'Плановый' ));

39. Пример 25. Программа (продолжение)

procedure FindDeptNum(DeptName:TStr12;var D:TDeptTable;
var DNum: integer);
var
{Поиск номера отдела по его имени}
i: integer;
begin
i:=1;
while (i<=ND) and (D[i].DName<>DeptName) do i:=i+1;
if i>ND then begin
writeln(' Отдела ',DeptName,' не существует.'); halt
end
else
DNum:=D[i].DNum;
end;

40. Пример 25. Программа (продолжение)

procedure MakeList(var Emp:TEmpTable; var EmpList:TEmpTable;
DNum:integer; var K:integer);
var
{Формирование списка сотрудников по номеру отдела}
i: integer;
begin
K:=0;
for i:=1 to NE do
if Emp[i].DNum=DNum then begin
K:=K+1;
EmpList[K]:=Emp[i]
end
end;

41. Пример 25. Программа (продолжение)

procedure PrintDept(var Dept:TDeptTable; ND:integer);
var
{Печать таблицы ОТДЕЛЫ}
i: integer;
begin
writeln;
writeln('*************************************');
writeln('* НОМЕР_ОТД * НАЗВАНИЕ *');
writeln('*************************************');
for i:=1 to ND do
with Dept[i] do begin
writeln('* ',DNum:5,'
* ',DName:12,' *');
end
end;

42. Пример 25. Программа (продолжение)

procedure PrintEmp(var EmpList:TEmpTable;N:integer);
var
{Печать таблицы СОТРУДНИКИ}
i: integer;
begin
writeln;
writeln('*****************************************************************');
writeln('*НОМЕР_СОТР*ФАМИЛИЯ*ЗАРПЛАТА*НОМЕР_ОТД*');
writeln('*****************************************************************');
for i:=1 to N do
with EmpList[i] do begin
writeln('* ',ENum:5,' * ',EName:15,' * ',ESal:8:2,' *',DNum:5,' *');
end
end;

43. Пример 25. Программа (окончание)

var
EmpList:TEmpTable;
DeptName:TStr12;
DNum,LNum:integer;
begin
write('Название отдела- ');
readln(DeptName);
PrintEmp(Emp,NE);
PrintDept(Dept,ND);
FindDeptNum(DeptName,Dept,DNum);
MakeList(Emp,EmpList,DNum,LNum);
writeln(' Отдел ',DeptName);
if LNum>0 then
PrintEmp(EmpList,LNum)
else
writeln(' Нет сотрудников.');
end.

44.

Пример 26
Вычислить сумму 1,4,7 и 9 элементов массива.
program Ex26;
type
TAr=array [1..10] of integer
var
A:TAr;
i,s:integer;
begin
for i:=1 to 10 do
readln(A[i]);
s:=0;
for i:=1 to 10 do
if i in [1,4,7,9] then
s:=s+A[i];
writeln(s);
end.

45.

Пример 27
Составить две программы. Первая (a) создает файл записей, компоненты
которых содержат значение имени и возраста. Вторая (b) считывает
записи из файла и вычисляет средний возраст, значение которого
записывается в текстовый файл .
program Ex27a;
type
TMRec= record
Name: string[15];
Age: integer;
end;
TFMRec= file of TMRec;
var
f:TFMRec;
r:TMRec;
i: integer;
begin
assign (f,'filerec.dat');
rewrite (f);
for i:=1 to 5 do begin
readln (r.Name,r.Age);
write (f,r)
end;
close(f);
end.

46.

program Ex27b;
type
TMRec= record
Name: string[15];
Age: integer;
end;
TFMRec= file of TMRec;
var
g: text;
f: TFMRec;
r: TMRec;
s: real;
num: integer;
begin
assign (f,'filerec.dat');
assign (g,'num.dat');
reset (f);
rewrite (g);
s:=0;
num:=0;
while not eof(f) do begin
read(f,r);
s:=s+r.Age;
num:=num+1;
end;
if num<>0 then begin
s:=s/num;
write (g, ‘Средний возраст=',s:6:2)
end
else
writeln (‘Файл пуст');
close (f);
close (g);
end.

47.

Пример 28
В модуле размещаются процедуры и функции, вычисляющие
произведение и сумму элементов целочисленного одномерного массива.
Максимальное число элементов массива равно 100.
Программа и модуль записываются в различные файлы. Имя файла, в
котором находится модуль, должно совпадать с идентификатором модуля.
Например, модуль Unit1 должен находиться в файле Unit1.pas.
Главная программа
program Ex28;
uses Unit1;
var
A:TArray;
i,N,ASum,P: integer;
begin
Readln(N);
for i:=1 to N do
Readln(A[i]);
Sum(A,N,ASum);
P:=Mult(A,N);
Writeln(ASum,' ',P)
end.

48. Модуль

unit Unit1;
interface
type
TArray= array [1..100] of integer;
procedure Sum(A:TArray;N: integer; var ASum: integer);
function Mult(A:TArray;N: integer):integer;
implementation
procedure Sum(A:TArray; N: integer; var ASum: integer);
var i: integer;
begin
ASum:=0;
for i:=1 to N do ASum:=ASum+A[i]
end;
function Mult(A:TArray;N:integer): integer;
var i,P: integer;
begin
P:=1;
for i:=1 to N do P:=P*A[i];
Mult:=P
end;
end.