Лабораторная работа №1
Структура программы на Паскале.
Организация ввода-вывода данных.
Использование стандартных функций.
1.Составить программу, вычисляющую и выводящую на экран значения приведенных ниже выражений. Значения переменных вводятся с клавиатуры.
; 
; 
; 
; 
(m, n, k, j – целые).
Указание. Использовать соотношения: 
; 
; 
; 
; 
.
program p1;
var x,y,a,b,c,d,z,s,p,q: real;
t:boolean;
m,n,k,j: integer;
begin
write('x='); readln(x);
write('y='); readln(y);
z:=x*x/(x*x+1);
a:=arctan(z/sqrt(1-z*z));
z:=1+sqrt(y*y*y*y+1);
b:=ln(z)/ln(10);
c:=exp((y-x*x)*ln(2));
d:=cos(2*x*y)/sin(2*x*y);
s:=(a-b)/(c-d);
writeln('s=',s:9:6);
z:=abs(x);
a:=exp(y*ln(z));
b:=abs(y);
c:=exp(x*ln(b))+1;
d:=sqrt(c);
p:=frac(a-d);
writeln('p=',p:9:6);
z:=sin(x+y+pi/4)/cos(x+y+pi/4);
a:=exp(pi-x*y);
c:=exp(-abs(y)*ln(2));
b:=arctan(sqrt(1-c*c)/c);
q:=z*a/(x*y-b);
writeln('q=',q:9:6);
t:=((abs(s)<abs(p)) or (abs(p)<abs(q)) and ((x*x-y*y)<1));
writeln('t=', t);
write('n='); readln(n);
write('j='); readln(j);
m:=(n shl 2)+n;
k:=(j div (j shr 1));
writeln('m=', m);
writeln('k=',k);
end.
1. Составить программу, определяющую, попала ли точка с координатами (x, y) внутрь заштрихованной области.
program interval;
var x,y: real;
begin
write('x='); readln(x);
write('y='); readln(y);
if ((x*x+y*y<9) and (y>=0) and (x>0) and (y<ln(x)) and (y>-x+2))
or ((x*x+y*y<9) and (y>x*x) and (y>-x+2) and (x>0)) then
writeln('точка принадлежит области')
else writeln('точка не принадлежит области');
readln
end.
4. Изучить и запустить программу, которая вычисляет сумму, разность, произведение или частное двух чисел в зависимости от знака операции +, –, *, / (т.е. простейший калькулятор). Добавить в программу операцию возведения x в степень y.
program calc;
var x,y,r:real;
c:char;
Begin
write('Операнд 1: '); readln(x);
write('Операция: '); readln(c);
write('Операнд 2: '); readln(y);
Case c of
'+': r:=x+y;
'-': r:=x-y;
'*': r:=x*y;
'/': if y<>0 then r:=x/y
else
begin writeln ('Деление на 0');exit end;
'^': if x>0 then r:=exp(y*ln(x))
else
begin writeln ('неверное значение x'); exit end;
else
begin writeln ('Hеверная операция');exit end;
end;
writeln (x:6:3,' ',c,' ',y:6:3,' = ',r:9:6);
readln
End.
5. Составить программу вычисления действительных корней квадратного уравнения ax 2 + bx + c = 0.
program korni;
var a,b,c,d,x1,x2: real;
begin
write('a b c: '); readln(a,b,c);
d:=b*b-4*a*c;
if d>0 then
begin
x1:=(-b+sqrt(d))/(2*a);
x2:=(-b-sqrt(d))/(2*a);
writeln('x1=',x1:9:6,' x2=',x2:9:6);
end
else if d=0 then
begin
x1:=-b/(2*a);
writeln('x1=',x1:9:6);
end
else writeln('нет корней');
readln
end.
Лабораторная работа №3
Программы циклической структуры.
1.Составить программы, вычисляющие значения выражений:
б) 
в) 
д) 
ж) 
к) 
.
Б )
program p1;
var n, i: integer;
s:real;
begin
write ('n=');
readln(n);
s:=0;
for i:=1 to n do
s:=s+1/exp(2/3*ln(i));
writeln ('s=',s:9:6);
readln
end.
В)
program p2v;
var i: integer;
s, ch, x, f:real;
begin
write ('x=');
readln(x);
s:=0; f:=1; ch:=x;
for i:=1 to 10 do
begin
f:=f/(2*i)/(2*i-1); ch:=ch*x;
s:=s+ch*f;
end;
writeln ('s=',s:9:6);
readln
end.
Д)
program p1d;
var n,k: integer;
x,s:real;
begin
write ('n='); readln(n);
write ('x='); readln (x);
s:=1;
for k:=1 to n do
s:=s*ln(k*x)/ln(2)/k;
writeln ('s=',s:9:6);
readln
end.
Ж)
program p1zh;
var i,j: integer;
s:real;
begin
s:=0;
for i:=1 to 10 do
for j:=i to 10 do
s:=s+1/(i+j*j);
writeln ('s=',s:9:6);
readln
end.
К)
program p1k;
var n,k: integer;
z,s:real;
begin
write ('n='); readln(n);
s:=0; z:=0;
for k:=1 to n do
begin
z:=z+sin(k);
s:=s+1/z;
end;
writeln ('s=',s:9:6);
readln
end.
2. Составить программу, находящую сумму всех двузначных чисел у которых число единиц делится нацело на число десятков.
program p3v;
var s1,d,e,k: integer;
begin
s1:=0;
for k:=10 to 99 do
begin
e:=k mod 10;
d:=k div 10;
if e mod d=0 then begin write(k,' '); s1:=s1+k; end;
end;
writeln('s1=', s1);
readln
end.
3. Составить программу, выводящую на экран все простые числа в интервале от 1 до 100 (простым называется число, которое делится нацело только на 1 и на себя).
program p4;
var n,k, del, rez: integer;
f:boolean;
begin
for n:=1 to 100 do
begin
f:=true;
for k:=2 to n div 2 do
if n mod k = 0 then f:=false;
if f then write(n,' ');
end;
readln
end.
4. Изучить и запустить программу вычисления значений функции на интервале x 1£ x £ x 2 с шагом h и найти ее максимальное и минимальное значение и среднее арифметическое:
program p6;
var x,y,a, x1, x2,h,xmin,ymin,SA, xmax, ymax: real;
n, i: integer;
begin
writeln('введите число а, начало и конец интервала и шаг h');
readln(a, x1, x2, h);
if (x2>x1) and ((x2-x1)>2*h) then
begin
x:=x1;
n:=round ((x2-x1)/h);
if (x>a) then y:=sqr(sin(abs(x))) else y:=cos(x*x);
writeln ('x=', x:7:3, ' y=', y:9:4);
xmin:=x; ymin:=y; xmax:=x; ymax:=y; SA:=y;
for i:=1 to n do begin
x:=x1+i*h;
if (x>a) then y:= sqr(sin(abs(x))) else y:=cos(x*x);
writeln ('x=', x:7:3,' y=', y:9:4);
if y<ymin then begin
ymin:= y; xmin:=x;
end;
if y>ymax then begin
ymax:=y; xmax:=x;
end;
SA:=SA+y;
end;
writeln('минимальное значение y =', ymin:9:4, ' при x=', xmin:7:3);
writeln('максимальное значение y =', ymax:9:4, ' при x=', xmax:7:3);
writeln('Среднее значение функция ', SA/(n+1):9:4);
end
else writeln ('Hеверно заданы х1 и х2');
readln
end.
5. Вычислить с помощью рекуррентной формулы сумму ряда с заданной точностью e (использовать оператор цикла с постусловием):
.
program p4;
var s,u,x,eps: real; {s – сумма, u – член ряда, eps - точность}
n: integer; {x – аргумент функции, n – номер члена ряда}
begin
writeln(’Введите аргумент x и точность eps’);
readln(x, eps);
u:=1; s:=u; n:=0; { инициализация переменных}
repeat
u:=–u*x*x/(2*n+1)/(2*n+2); {рекуррентная формула}
s:=s+u; {суммирование ряда}
n:=n+1; {счетчик}
until abs(u)<eps;
writeln(’Сумма ряда равна ’, s:10:6);
writeln(’Для сравнения cos(x)=’, cos(x):10:6);
readln
end.
6.Вычислить суммы рядов с точностью e = 0,0001. Использовать, где это целесообразно, рекуррентные формулы. Использовать цикл с предусловием (а, в), с постусловием (б, г):
в) 
г) 
В)
program p5v;
var eps,a,s:real;
n: integer;
begin
write ('eps='); readln(eps);
a:=2; s:=a; n:=1;
while abs(a)>eps do
begin
a:=-2/(n+1)*a;
s:=s+a; n:=n+1;
end;
writeln ('s=', s:12:10);
end.
Г)
program p5g;
var eps,a,s: real;
n: integer;
begin
write ('eps='); readln(eps);
a:=-1/6; s:=a; n:=1;
repeat
a:=-n*a/(2*n+6);
s:=s+a; n:=n+1;
until abs(a)<eps;
writeln('s=',s:9:6);
end.
7. Вычислить суммы рядов с точностью e = 0,0001. Использовать, где это целесообразно, рекуррентные формулы.
program p5b;
var eps,a,s: real;
n: integer;
begin
write ('eps='); readln(eps);
s:=0; n:=2;
repeat
a:=exp(n*n*ln((n-1)/(n+1)));
s:=s+a; n:=n+1;
writeln(a:9:6)
until abs(a)<eps;
writeln('s=',s:9:6);
end.
Лабораторная работа №4
Работа с массивами и строками.
1. Изучить и запустить программу, осуществляющую ввод массива с клавиатуры, сортировку его по убыванию и вывод на экран. С ее помощью составить программу, выполняющую следующие действия над вещественным одномерным массивом А (n):
а) поиск и вывод на экран минимального и максимального элементов с указанием номера;
б) перестановку элементов массива (1-го с последним, 2-го с предпоследним, и т.д.);
program p1a;
var A: array [1..100] of real;
i,j,n,imax,imin: integer;
z,max,min,m: real;
begin
write ('введите длину массива (n<100):');
readln (n);
writeln ('введите элементы массива:');
for i:=1 to n do
begin
write ('A [', i, ']=');
readln (A [i])
end;
writeln('Массив А:');
for i:=1 to n do write (A [i]:6:3, ' ');
writeln;
{a}
max:=a[1]; imax:=1;
min:=a[1]; imin:=1;
for i:=2 to n do begin
if max<a[i] then begin max:=a[i]; imax:=i; end;
if min>a[i] then begin min:=a[i]; imin:=i; end;
end;
writeln ('max=',max:6:3,' в позиции ',imax);
writeln ('min=',min:6:3,' в позиции ',imin);
{б}
for i:=1 to n div 2 do
begin
z:=A[i];
A[i]:=A[n+1-i];
A[n+1-i]:=z;
end;
writeln ('Массив А после перестановки:');
for i:=1 to n do write(A [i]:6:3, ' ');
writeln;
{в}
for i:=1 to n-1 do
for j:=i+1 to n do
if A [i]>A [j] then
begin
z:=A[i]; A[i]:=A[j]; A[j]:=z;
end;
writeln ('отсортированный массив:');
for i:=1 to n do write(A [i]:6:3, ' ');
writeln;
readln
end.
2. Изучить и запустить программу, осуществляющую ввод матрицы А с клавиатуры, перестановку указанных строк и вывод матрицы на экран в виде таблицы. С ее помощью составить программу, выполняющую следующие действия над вещественным двумерным массивом А (m ´ n), m ≠ n:
в) транспонирование матрицы А;
г) вычисление и печать результатов перемножения матриц А и А Т: B = АА Т, С = А Т А.
д) перестановку столбцов матрицы А, чтобы максимальный элемент оказался в первом столбце, и перестановку строк, чтобы он оказался в левом верхнем углу матрицы.
program v2;
var at,B,C,A: array [1..10,1..10] of real;
i,j,k,n,m,m1,m2,imax,jmax: integer;
z,max: real;
begin
write('введите число строк (m<10):');
readln(m);
write('введите число столбцов (n<10):');
readln(n);
for i:=1 to m do
for j:=1 to n do
begin
write('A[', i, ',', j, ']=');
readln(a[i,j])
end;
writeln('исходная матрица:');
for i:=1 to m do
begin
for j:=1 to n do write(a[i,j]:6:2, ' ');
writeln
end;
{в}
for i:=1 to n do
for j:=1 to m do at[i,j]:=A[j,i];
writeln ('Матрица At:');
for i:=1 to n do
begin
for j:=1 to m do write(at[i,j]:6:2, ' ');
writeln
end;
{г}
for i:=1 to m do
for j:=1 to m do
begin
b[i,j]:=0;
for k:=1 to n do b[i,j]:=b[i,j]+A[i,k]*at[k,j];
end;
writeln ('Матрица B=A*at:');
for i:=1 to m do
begin
for j:=1 to m do write(b[i,j]:6:2, ' ');
writeln
end;
for i:=1 to n do
for j:=1 to n do begin
c[i,j]:=0;
for k:=1 to m do
c[i,j]:=c[i,j]+at[i,k]*A[k,j];
end;
writeln ('Матрица c=at*A:');
for i:=1 to n do
begin
for j:=1 to n do write(c[i,j]:6:2, ' ');
writeln
end;
{д}
max:=a[1,1];
imax:=1; jmax:=1;
for i:=1 to m do
for j:=1 to n do
if a[i,j]>max then
begin
max:=a[i,j];
imax:=i;
jmax:=j
end;
writeln(imax,' ',jmax);
if jmax<>1 then
for i:=1 to m do begin
z:=a[i,1]; a[i,1]:=a[i,jmax]; a[i,jmax]:=z;
end;
writeln('матрица 1:');
for i:=1 to m do
begin
for j:=1 to n do write(a[i,j]:6:2, ' ');
writeln
end;
if imax<>1 then
for j:=1 to n do begin
z:=a[1,j]; a[1,j]:=a[imax,j]; a[imax,j]:=z;
end;
writeln('матрица 2:');
for i:=1 to m do
begin
for j:=1 to n do write(a[i,j]:6:2, ' ');
writeln
end;
{ write('введите номера переставляемых строк:');
readln(m1, m2);
if(m1>m) or (m2>m) or (m1=m2) then
begin
writeln('неверные номера строк');
exit
end;
for j:=1 to n do
begin
z:=a[m1,j]; a[m1,j]:=a[m2,j]; a[m2,j]:=z
end;
writeln('матрица после перестановки:');
for i:=1 to m do
begin
for j:=1 to n do write(a[i,j]:6:2, ' ');
writeln
end; }
readln
end.
3. Составить программу, которая во введенной с клавиатуры строке удаляет лишние пробелы между словами, оставляя один.
program p3;
var s: string;
j,i: integer;
begin
writeln('Введите строку:');
readln(s);
for i:=2 to length(s) do
if(S[i]=' ') and (s[i-1]=' ') then begin
for j:=i to length(s)-1 do
s[j]:=s[j+1];
s[0]:=chr(ord(s[0])-1);
i:=i-1;
end;
writeln('Результат:');
writeln(s);
readln
end.
Лабораторная работа №5
Процедуры и функции.
2. Изучить и запустить программу вычисления длины вектора, заданного в виде массива из 3 чисел, в которой вычисление длины вектора реализовано в виде функции. С ее помощью составить программу обработки векторов, заданных в виде массива из 3 чисел, выполняющую следующие действия: а) вычисление скалярного произведения двух векторов; б) вычисление угла между двумя векторами;
program vectors;
type vect=array[1..3] of real;
var a,b: vect;
z:real;
function len(x:vect):real;
begin
len:=sqrt(x[1]*x[1]+x[2]*x[2]+x[3]+x[3])
end;
function sp(x,y:vect):real;
begin
sp:=x[1]*y[1]+x[2]*y[2]+x[3]+y[3]
end;
function ygol(x,y:vect):real;
var t:real;
begin
t:=sp(x,y)/len(x)/len(y);
if t=0 then ygol:=pi/2
else
ygol:=arctan(sqrt(1-t*t)/t);
end;
begin
writeln('введите компоненты векторa а');
readln(a[1],a[2],a[3]);
writeln('введите компоненты вектора b');
readln(b[1],b[2],b[3]);
z:=sp(a,b);
writeln('а,b: ',z:6:2);
readln;
z:=ygol(a,b);
writeln('угол=',z*180/pi:6:2,' градусов');
readln;
end.
3. Изучить и запустить программу, осуществляющую ввод квадратных матриц А и В и вывод их суммы С = А + В (ввод, вывод и сложение матриц реализованы в виде процедур). С ее помощью составить программу обработки матриц, выполняющую следующие действия (реализовать в виде процедур):
а) транспонирование матрицы A;
б) вычисление произведения двух матриц С = АВ;
program matrix;
type matr=array[1..10,1..10] of real;
var a,b,c,at: matr;
n: integer;
procedure inp(var x:matr; n:integer; t:char);
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do
begin
write(t,'[', i, ',', j, ']=');
readln(x[i,j])
end
end;
procedure outp(x:matr; n:integer);
var i,j: integer;
begin
for i:=1 to n do
begin
for j:=1 to n do write(' ',x[i,j]:6:2);
writeln
end
end;
procedure sum(x,y:matr; n:integer; var s:matr);
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do s[i,j]:=x[i,j]+y[i,j]
end;
procedure trans(x:matr; n:integer; var xt:matr);
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do xt[i,j]:=x[j,i]
end;
procedure tr(x,y:matr; n:integer; var c:matr);
var i,j,k:integer;
begin
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]+ x[i,k]*y[k,j];
end;
end;
begin
writeln('Введите размерность матриц n: ');
readln(n);
writeln('Введите матрицу а');
inp(a,n,'A');
writeln(' матрица а:');
outp(a,n);
writeln('Введите матрицу б');
inp(b,n,'b');
writeln(' матрица б:');
outp(b,n);
sum(a,b,n,c);
writeln('Матрица с=а+б:');
outp(c,n);
trans(a,n,at);
writeln(' Матрица at:');
outp(at,n);
tr(a,b,n,c);
writeln('Матрица c=a*b:');
outp(c,n);
readln
end.