Лабораторная №1 (№41)
Дано
Протабулировать функции
R=
w(t)=3t3-4t2+6t-1
sign(t)=
F(t)=
-3.5t1.5, t=0.5
Листинг
program John1;
uses crt;
var f,n,sign,a:integer;
r,t,w:real;
begin
clrscr;
writeln('Задание N1');
writeln;
writeln('г==========T==========T==========T==========¬');
writeln('¦ ',' t ',' ¦ ','w ',' ¦ ','','r ',' ¦ ',' N ',' ¦');
writeln('¦==========+==========+==========+==========¦');
for a:=1 to 11 do
begin
t:=(a-8)/2;
w:=3*t*t*t-4*t*t+6*t-1;
if t>=0 then sign:=1 else sign:=-1;
if t<0>
if w>=0 then begin r:=1+3*f; n:=1; end;
if w<0>
writeln('¦ ',t:4:1,' ','¦',w:8:3,' ','¦ ',r:7:3,' ','¦ ',' ',n,' ',' ¦');
end;
writeln('L==========¦==========¦==========¦==========-');
readln;
end.
Результат работы
t |
w |
r |
n |
-3.5 |
-199.625 |
40.875 |
2 |
-3.0 |
-136.000 |
25.000 |
2 |
-2.5 |
-87.875 |
13.625 |
2 |
-2.0 |
-53.000 |
6.000 |
2 |
-1.5 |
-29.125 |
1.375 |
2 |
-1.0 |
-14.000 |
-1.000 |
2 |
-0.5 |
-5.375 |
-1.875 |
2 |
0 |
-1.000 |
2.000 |
2 |
0.5 |
1.375 |
1.000 |
1 |
1.0 |
4.000 |
1.000 |
1 |
1.5 |
9.125 |
1.000 |
1 |
Лабораторная №2 (№41)
Дано
Найти сумму ряда с точность до e
Листинг
program John2;
uses crt;
var k,a,n:integer;
s,e,f,x:real;
begin
clrscr;
write('Введите точность вычисления e=');
readln(e);
write('Введите переменную ряда |x|<1>
readln(x);
s:=0;
k:=0;
n:=1;
repeat
if k=0 then f:=x else
for a:=1 to k do
begin
n:=n*a;
if x<0>
else f:=exp((2*k+1)*ln(abs(x)))/n*(2*k+1);
s:=s+f;
end;
k:=k+1;
until
abs(f)
writeln;
writeln('сумма
ряда s=',s:11:9, '':10,'количество итераций
k=',k);
readkey;
end.
Результат
работы
Ввод
Вывод
e=0.0001
s=0.003075
|x|<0,|x|=0.1
k=3
Лабораторная
№3 (№65)
Дано
Найти
корень уравнения 1,1x3-2.1x2+7x+8.2=0
на промежутке [-1;0] с точностью до e
методом дихотомии и методом касательных.
Листинг
Program
John3;
uses
crt;
var
n,k:integer;
a,b,c,c1,c2,eps,x,x1:real;
Function
f(z:real):real;
begin
f:=1.1*Z*Z*Z-2.1*Z*Z+7*Z+8.2;
end;
Function
f1(y:real):real;
begin
f1:=3.3*y*y-4.2*y+7;
end;
Function
f2(q:real):real;
begin
f2:=9.9*q-4.2;
end;
Begin
clrscr;
a:=-1;
b:=0;
eps:=0.001;
writeln('Нахождение
корней уравнения 1.1*x^3-2.1*x^2+7*x+8.2 на
промежутке [-1;0]');
writeln('========================================================================');
writeln;
if
f(a)*f(b)>0 then write('На Промежутке от ',a:4:2,'
до ',b:4:2,' функция не имеет корня!');
if
f(a)=0 then x:=a;
if
f(b)=0 then x:=b
else
begin
n:=0;
writeln('г=================================¬');
writeln('¦
Метод дихотомии ¦');
repeat
begin
n:=n+1;
c:=(a+b)/2;
if
f(c)=0 then x:=c;
if
f(a)*f(c)<0>
if
f(c)*f(b)<0>
end;
until
abs((b-a)*2)
x:=(a+b)/2;
writeln('¦
Корень уравнения равен:',x:7:5,' ¦');
writeln('¦
Число интераций равно:',n,'¦':9);
writeln('L=================================-');
writeln;
writeln('г=================================¬');
writeln('¦
Метод касательных ¦');
k:=0;
if
f1(a)*f2(a)>0 then b:=c1 else a:=c1;
if
f(c1)=0 then x1:=c1;
repeat
k:=k+1;
c2:=c1;
c1:=c1-f(c1)/f1(c1);
until
abs(c2-c1)
x1:=a-f(a)/f1(a);
writeln('¦
Корень уравнения равен:',c1:7:5,' ¦');
writeln('¦
Число итераций равно:',k,'¦':11);
writeln('L=================================-');
repeat
until KeyPressed;
end;
end.
Результат
работы
Метод
дихотомии Метод касательных
x=-0.85425
x=-0.85441
n=11
n=4
Лабораторная
№4 (№155)
Дано
Задана
матрица B(bij),
сформировать матрицу A(aij),
чтоб aij=
Вычислить
сумму элементов нечетных строк матрицы.
Листинг
program
John4;
uses
crt;
var
i,j,n,m:integer;
s:real;
a,b:array[1..50,1..50]
of real;
procedure
vvod;
begin
write('Введите
длину
строки
n=');
readln(n);
write('Введите
длину столбца m=');
readln(m);
writeln('================================================================================');
end;
procedure
vyvod;
begin
randomize;
writeln('Исходный
массив');
for
i:=1 to n do
begin
for
j:=1 to m do
begin
b[i,j]:=random(100);
write(b[i,j]:10:3);
end;
writeln;
end;
end;
procedure
vyvod2;
begin
writeln('================================================================================');
writeln('Массив
после преобразования');
for
i:=1 to n do
begin
for
j:=1 to m do
begin
a[i,j]:=b[i,j]/(b[i,j]+2.3*sqr(b[i,j])+2.8);
write(a[i,j]:10:3);
end;
writeln;
end;
end;
begin
clrscr;
vvod;
vyvod;
vyvod2;
writeln('================================================================================');
writeln('Суммы
нечетных строк');
for
i:=1 to n do
begin
s:=0;
for
j:=1 to m do
if
odd(i) then s:=s+a[i,j];
if
odd(i) then write (s:10:3);
writeln;
end;
readln;
end.
Результат
работы
Ввод
данных n=3
m=4
Исходный
массив B
47
25 80 41
46
39 32 27
13
64 52 28
Сформированный
массив A
0,009
0,017 0,005 0,010
0,009
0,011 0,013 0,016
0,032
0,007 0,008 0,015
Суммы
нечетных строк
0,042
0,062
Лабораторная
№5 (№155)
Дано
Задана
матрица B(bij),
сформировать матрицу A(aij),
чтоб aij=
Вычислить
сумму элементов нечетных строк матрицы.
Листинг
Программа5
uses
unit1,crt;
var
a,b:mas;
begin
clrscr;
Input;
Vyvod1(a,b);
Vyvod2(a,b);
summa(a,b);
readln;
end.
Юнит1
unit
unit1;
interface
uses
crt;
type
mas=array [1..20,1..20] of real;
var
i,j,n,m:integer;
s:real;
procedure
Input;
procedure
Vyvod1(var a,b:mas);
procedure
Vyvod2(var a,b:mas);
procedure
Summa(var a,b:mas);
implementation
procedure
Input;
begin
write('Введите
длину строки n=');
readln(n);
write('Введите
длину столбца m=');
readln(m);
writeln('================================================================================');
end;
procedure
Vyvod1;
begin
randomize;
writeln('Исходный
массив');
for
i:=1 to n do
begin
for
j:=1 to m do
begin
b[i,j]:=random(100);
write(b[i,j]:10:3);
end;
writeln;
end;
end;
procedure
Vyvod2;
begin
writeln('================================================================================');
writeln('Массив
после преобразования');
for
i:=1 to n do
begin
for
j:=1 to m do
begin
a[i,j]:=b[i,j]/(b[i,j]+2.3*sqr(b[i,j])+2.8);
write(a[i,j]:10:3);
end;
writeln;
end;
end;
procedure
Summa;
begin
writeln('================================================================================');
writeln('Суммы
нечетных строк');
for
i:=1 to n do
begin
s:=0;
for
j:=1 to m do
if
odd(i) then s:=s+a[i,j];
if
odd(i) then write (s:10:3);
writeln;
end;
end;
end.
Результат
работы
Ввод
данных n=3
m=4
Исходный
массив B
47
25 80 41
46
39 32 27
13
64 52 28
Сформированный
массив A
0,009
0,017 0,005 0,010
0,009
0,011 0,013 0,016
0,032
0,007 0,008 0,015
Суммы
нечетных строк
0,042
0,062
Лабораторная
№6
Дано
Список
бытовая техника. Колонки: Название
товара, год выпуска, гарантия, цена.
Выбрать товары указанного производителя,
выпущенные после 1998 года с гарантией
больше 12 месяцев с ценной находящейся
в заданных пределах. Отсортировать
список по алфавиту.
Листинг
Список
товаров
Телевизор
Sony 1999 24 237
Магнитофон
LG 2000 18 247
Видеомагнитофон
Panasonic 1999 18 179
Видеоплеер
Samsung 1998 12 164
Пылесос
Philips 2000 18 208
Музыкальный_центр
Samsung 2000 18 178
Домашний_кинотеатр
LG 1998 24 224
Фен
Philips 2000 12 103
Электрочайник
TEFAL 2000 12 212
СВЧ-печь
Samsung 1999 12 169
Утюг
TEFAL 1998 12 119
Телевизор
Panasonic 2000 24 241
Магнитофон
Sony 1998 18 167
Видеомагнитофон
LG 2000 18 175
Видеоплеер
Panasonic 2000 18 182
Пылесос
Sony 1999 18 201
Музыкальный_центр
LG 1998 12 186
Домашний_кинотеатр
Panasonic 2000 24 234
Фен
Samsung 2000 12 108
Электрочайник
Philips 1999 12 103
СВЧ-печь
TEFAL 1998 12 172
Утюг
Philips 2000 12 115
Телевизор
Samsung 2000 24 209
Телефон
Panasonic 1999 12 102
Видеомагнитофон
Sony 2000 18 181
Видеоплеер
LG 2000 12 162
CD-плеер
Samsung 1998 12 101
Музыкальный_центр
Panasonic 1999 18 196
Домашний_кинотеатр
Sony 2000 24 245
Фен
TEFAL 2000 12 101
Телефон
Samsung 1999 12 123
CD-плеер
Sony 2000 12 120
Электробритва
Philips 1999 12 134
Программа6
uses
crt;
type
tovar=record
ima:string[19];
izg:string[10];
god:integer;
gar:integer;
cena:integer;
end;
var
tov:text;
izgot:string;
z,i,o,np,vp,j,k:integer;
st,p,r:array
[1..25] of tovar;
pr:array
[1..30] of integer;
temp:tovar;
pos1:
byte;
begin
{assign(tov,'d:\univer\langs\bp7\work\temp\tov.txt');}
assign(tov,'c:\tp\work\temp\tov.txt');
reset(tov);
clrscr;
writeln('':30,'Список
электротоваров');
writeln('Наименование
товара','':5,'Производитель','':7,'Год','':5,'Гарантия','':4,'Цена');
readln;
z:=1;
repeat
readln(tov,st[z].ima,st[z].izg,st[z].god,st[z].gar,st[z].cena);
writeln(st[z].ima,'':6,st[z].izg,'':7,st[z].god,
'':7,st[z].gar,'':7,st[z].cena);
z:=z+1;
until
eof(tov);
for
i:=1 to z do
begin
pos1:=pos('
',st[i].izg);
While
pos1>0 do
begin
delete(st[i].izg,pos1,1);
pos1:=pos('
',st[i].izg);
end;
end;
writeln('Количество
товаров ',z);
readln;
write('Введите
изготовителя:');
readln(izgot);
write('Введите
нижний предел цены:');
readln(np);
write('Введите
верхний предел цены:');
readln(vp);
writeln('
Отсортированный список:');
writeln;
k:=0;
for
i:=1 to z do
if
(st[i].izg=izgot)and(st[i].cena>np)and(st[i].cena
begin
k:=k+1;
r[k]:=st[i];
end;
for
j:=1 to k-1 do
for
i:=j+1 to k do
if
r[i].ima
begin
temp:=r[i];
r[i]:=r[j];
r[j]:=temp;
end;
writeln('Количество
найденных товаров ',k);
for
i:=1 to k do
writeln(r[i].ima,'':6,r[i].izg,'':7,r[i].god,
'':7,r[i].gar,'':7,r[i].cena);
readln;
end.
Результат
работы
Список
товаров
Телевизор
Sony 1999 24 237
Магнитофон
LG 2000 18 247
.
. . . . . . . . . . . . . . . . . . . .
CD-плеер
Sony 2000 12 120
Электробритва
Philips 1999 12 134
Количество
товаров:34
Введите
изготовителя:Sony
Введите
нижний предел цены:100
Введите
верхний предел цены:250
Видеомагнитофон
Sony 2000 18 181
Домашний_кинотеатр
Sony 2000 24 245
Телевизор
Sony 1999 24 237
Пылесос
Sony 1999 18 201
Лабораторная
№7
Дано
На
основе лабораторной №3 построить график,
используя цветовое графическое меню
с пунктами: Ввод данных; Расчет; Построение;
Графические возможности; Помощь; Выход;
Листинг
Программа7
uses
crt;
type
tovar=record
ima:string[19];
izg:string[10];
god:integer;
gar:integer;
cena:integer;
end;
var
tov:text;
izgot:string;
z,i,o,np,vp,j,k:integer;
st,p,r:array
[1..25] of tovar;
pr:array
[1..30] of integer;
temp:tovar;
pos1:
byte;
begin
{assign(tov,'d:\univer\langs\bp7\work\temp\tov.txt');}
assign(tov,'c:\tp\work\temp\tov.txt');
reset(tov);
clrscr;
writeln('':30,'Список
электротоваров');
writeln('Наименование
товара','':5,'Производитель','':7,'Год','':5,'Гарантия','':4,'Цена');
readln;
z:=1;
repeat
readln(tov,st[z].ima,st[z].izg,st[z].god,st[z].gar,st[z].cena);
writeln(st[z].ima,'':6,st[z].izg,'':7,st[z].god,
'':7,st[z].gar,'':7,st[z].cena);
z:=z+1;
until
eof(tov);
for
i:=1 to z do
begin
pos1:=pos('
',st[i].izg);
While
pos1>0 do
begin
delete(st[i].izg,pos1,1);
pos1:=pos('
',st[i].izg);
end;
end;
writeln('Количество
товаров ',z);
readln;
write('Введите
изготовителя:');
readln(izgot);
write('Введите
нижний предел цены:');
readln(np);
write('Введите
верхний предел цены:');
readln(vp);
writeln('
Отсортированный список:');
writeln;
k:=0;
for
i:=1 to z do
if
(st[i].izg=izgot)and(st[i].cena>np)and(st[i].cena
begin
k:=k+1;
r[k]:=st[i];
end;
for
j:=1 to k-1 do
for
i:=j+1 to k do
if
r[i].ima
begin
temp:=r[i];
r[i]:=r[j];
r[j]:=temp;
end;
writeln('Количество
найденных товаров ',k);
for
i:=1 to k do
writeln(r[i].ima,'':6,r[i].izg,'':7,r[i].god,
'':7,r[i].gar,'':7,r[i].cena);
readln;
end.
Юнит7
unit
unit_7;
interface
uses
crt,graph;
var
i,j:integer;
procedure
menu(var n:integer);
implementation
procedure
menu;
var
c:array [1..6] of integer;
st:array
[1..6] of string;
key:char;
begin
key:=#0;
cleardevice;
n:=1;
setcolor(9);
rectangle(10,10,630,470);
rectangle(15,15,625,465);
setcolor(2);
rectangle(205,145,390,185);
rectangle(205,185,390,235);
rectangle(205,235,390,290);
rectangle(205,290,390,340);
rectangle(205,340,390,390);
rectangle(205,390,390,425);
setcolor(14);
settextstyle(2,0,16);
outtextxy(170,40,'Лабороторная
N7');
setcolor(15);
settextstyle(6,0,2);
outtextxy(20,440,'Программа
сделана студентом группы 00-ПО2 Гольдиным
Е.');
for
i:=1 to 6 do c[i]:=3;
st[1]:='Ввод
данных';
st[2]:='Расчет';
st[3]:='График
функции';
st[4]:='Заставка';
st[5]:='Помощь';
st[6]:='Выход';
settextstyle(4,0,2);
while
key<>#13 do
begin
c[n]:=4;
for
i:=1 to 6 do
begin
setcolor(c[i]);
outtextxy(140+(150-length(st[i])*5),100+i*50,st[i]);
end;
key:=readkey;
if
(key=#72)and(n<>1) then
begin
sound(250);
delay(50);
nosound;
c[n]:=3;
n:=n-1;
end;
if
(key=#80)and(n<>6) then
begin
sound(250);
delay(50);
nosound;
c[n]:=3;
n:=n+1;
end;
end;
end;
end.