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

Программа
{ Автор: Иванов И. И. }
{ Группа: ФФ-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.

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.
Пример 2.
Составить программу, вычисляющую значение следующей функции:
y:=x2
y:=-x

Пример 3.
Составить программу, вычисляющую значение следующей функции:
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.
p:=1
p:=x-y
p:=x+y
p:=x*y

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

Вычисление суммы
Вычислить сумму элементов множества {ai|i=1..N}. Для вычисления суммы n элементов следует прибавить элемент an к сумме 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.
Пример 6.
Составить программу вычисления суммы:
элемент суммы
для вычисления (– 1) используем соотношение

Вычисление бесконечной суммы
Пример 7.
Вычислить сумму
Суммирование прекращается при
Выведем рекуррентную формулу для ai.
Имеем:
Проверка:
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.
Вычислить наименьший номер элемента последовательности, заданной рекуррентной формулой:
для которого выполняется условие:
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.
Таблица трассировки

Определение максимального (минимального) элемента множества
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.
Пример 9.
Определить номер максимального элемента множества {ai | i=1..30},
где
Рекуррентные соотношения:
В качестве начального значения переменной, предназначенной для хранения текущего значения максимального (минимального) элемента, следует использовать один из элементов множества.

Пример 11.
Составить программу, выполняющую поиск целочисленных решений уравнения
в интервале значений каждой переменной от 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

Пример использования вспомогательных процедур для управления циклами
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
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.

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

Программа для примера 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:=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 .

Пример 14. Вложенные подпрограммы
program Ex14;
procedure Outer;
procedure Inner;
begin writeln('Inner');
end;
begin
writeln('Outer');
Inner;
end;
begin
Outer
end.
Внутренняя процедура
Внешняя процедура

Пример 15. Использование подпрограмм в качестве параметров.
Составить программу, которая вычисляет и распечатывает в виде таблицы значения заданных функций:
Вычисление заданных функций и построение таблицы следует реализовать в виде подпрограмм.
Вычислить значение выражения:
Для заданных значений x, y и z.

Программа для примера 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;

Продолжение программы для примера 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.

Пример 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;
begin
readln(N);
NN:=Nf(N);
writeln(NN);
end.

Пример 17.
Составить программу, определяющую номер максимального элемента в заданном множестве действительных чисел.
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.
В программе предполагается, что массив NumSet может содержать до ста элементов. Реальное число элементов множества вводится с клавиатуры и присваивается переменной N.
Значение максимального элемента сохраняется в переменной MaxReal, а соответствующий номер - в переменной NumOfMax.

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

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.

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;
Пример 19.Линейный поиск

Пример 19. Двоичный поиск
procedure DSearch(A:TArN; N: integer; x: integer;var Num: integer);
var L,R,M : integer;
begin
L:=1;
R:=N;
while L
M:=(L+R) div 2;
if x>A[M] then
L:=M+1
else
R:=M
end;
if A[R]<>X then
writeln(' Элемент отсутствует')
end;

Пример 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.

Программа рассчитана на худший случай, когда минимальный элемент находится в конце последовательности и учитывает, что максимальный элемент перемещается в требуемое место за один проход.
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.
Пример 20. Пузырьковая сортировка.

Пример 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]
while x
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
if i
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 .

Пример 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.

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

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

Пример 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;
Пример 24. Программа (начало)

Пример 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:=D;
IMin:=I;
JMin:=J;
end
end
end;

var
IMin,JMin: integer;
SMin: real;
begin
MinDist(PointsSet,IMin, JMin,SMin);
writeln(IMin:3,' ',JMin:3, ' ',SMin:7:2);
end.
Пример 24. Программа (окончание)

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

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;
Пример 25. Программа (начало)

Пример 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:'Плановый' ));

Пример 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;

Пример 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;

Пример 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;

Пример 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;

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.
Пример 25. Программа (окончание)

Пример 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.

Пример 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.

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.

Пример 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.
Главная программа