Новые сообщения · Правила  
  • Страница 1 из 1
  • 1
Форум ПРОГРАММИСТОВ » КУРС ОПР - ПАСКАЛЬ » Лабораторные работы » Лабораторная работа №9 (Процедуры и функции)
Лабораторная работа №9
Цель - изучение процедур и функций.

Представленные ниже задания решить с использованием процедур или функций.

1. Напишите программу, которая решает систему линейных уравнений методом Гаусса. В качестве параметров в процедуру передавать коэффициенты матрицы системы и столбец свободных членов.

2. Напишите программу, решающую систему линейных уравнений матричным методом. В качестве параметров в процедуру передавать коэффициенты матрицы системы и столбец свободных членов. Порядок системы не выше четырех.

3. Напишите программу, вычисляющую произведение двух матриц. В процедуру передаются матрицы и их размеры.

4. Напишите программу, которая проверяет как расположена прямая и плоскость в пространстве. У вас задано несколько прямых.

5. Напишите программу, вычисляющую значения углов в многоугольнике.

6. Напишите программу, которая находит объем пирамиды, по заданным координатам вершин. Вам даны несколько наборов координат для разных пирамид.

7. Ваша программа должна вычислять векторное произведение двух векторов. У вас задано несколько пар векторов.

8. Напишите программу-калькулятор, умеющую складывать, вычитать или умножать скалярно два вектора. В процедуру передавать координаты векторов и операцию.

9. Напишите программу, умеющую находить высоту треугольной пирамиды, для которой заданы координаты ее вершин. У вас задано несколько наборов точек, задающих пирамиду.

10. Даны несколько наборов координат четырех вершин четырехугольника. Написать программу, вычисляющую площадь четырехугольника.

11. Для группы студентов заданы их оценки по пяти предметам. Используя записи и процедуры, написать программу, которая выводит список студентов, которым назначена стипендия. Стипендия назначается, если средний балл 4.0 и выше. Студентов оценивают по пятибальной системе.

12. Напишите программу, которая определяет тип четырехугольника (квадрат, прямоугольник, трапеция, параллелограмм) по заданным координатам вершин. У вас дано несколько наборов координат.

13. У вас есть зарплатная ведомость, в которой указано количество часов, отработанных работниками цеха за месяц и заработок за месяц. Вывести на печать такую же ведомость, но с дополнительной колонкой, в которой указана средняя заработная плата за день.

14. Дано несколько наборов координат вершин треугольника в пространстве. Определить тип треугольника (равносторонний, прямоугольный, тупоугольный, равнобедренный).

15. Даны вершины треугольника в пространстве. Найти все три высоты треугольника.

16. Даны вершины треугольной пирамиды. Найти площади всех граней.

17. Вводится несколько арифметических выражений без скобок, в которых пропущены знаки операций (плюс, минус, умножить). Пропущенные знаки заменены знаком вопроса. Например, 3?5?7?12=5. Вставить пропущенные знаки так, чтобы получилось верное равенство. Если это не возможно - вывести соответствующее сообщение.
1 | Автор: admin | 2014-10-27, 21:43   |  Репутация: [ + 21 ]
3. Напишите программу, вычисляющую произведение двух матриц. В процедуру передаются матрицы и их размеры.

Код
program AlenaKit9;
const   
N=10;
type
matrica=array[1..N,1..N] of real;
var
A,B,C:matrica;
ksA,kstA,ksB,kstB:integer;

procedure umn(x,y:integer; var D:matrica);
var
i, j, k: integer;
begin
for i:=1 to x do
for j:=1 to y do begin
D[i,j]:=0;
for k:=1 to n do
D[i,j]:=D[i,j]+A[i,k]*B[k,j];

end;
end;

procedure vvod(x,y:integer;var k:matrica);
var   
i,j:integer;
begin
for
i:=1 to x do
for
j:=1 to y do begin

readln (K[i,j]);
writeln;
end;
writeln('Матрица ');
For i:=1 to x do
         Begin
        for j:=1 to y do     
        Write(K[i,j]:5);
        writeln;
         End;
end;

procedure vivod(x,y:integer;C:matrica);   
var i,j:integer;
begin
For i:=1 to x do
Begin
for j:=1 to y do   
Write(C[i,j]:5);
writeln;
End;

end;

begin
repeat
write('количество строк в А = ');
read(ksA);
write('количество столбцов в А = ');
read(kstA);
write('количество строк в В = ');
read(ksB);
write('количество столбцов в В = ');
read(kstB);
if kstA<>ksB then writeln('Ошибка,матрица не совмесна');
until
kstA=ksB;

writeln('Введите элементы матрици А ');
vvod(ksA,kstA,A);
writeln('Введите элементы матрици В');
vvod(ksB,kstB,B);
umn(ksA,kstB,C);
writeln('Результат умножения матриц');
vivod(ksA,kstB,C)

end.




AlenaKit♥
2 | Автор: AlenaKit | 2014-10-30, 22:48 | Изменено: AlenaKit - Чт, 2014-10-30, 23:32   |  Репутация: [ + 12 ]
4. Напишите программу, которая проверяет как расположена прямая и плоскость в пространстве. У вас задано несколько прямых. 

Код
program ira_butenko97;
var A,B,C,x0,y0,z0,m,n,p,D,rez:real;

function Rezult(A,B,C,x0,y0,z0,m,n,p,D: real): real;
begin
if A*m+B*n+C*p<>0 then Rezult:=0;
if (A*m+B*n+C*p=0)and(A*x0+B*y0+C*z0+D=0) then Rezult:=1;
if (A*m+B*n+C*p=0)and(A*x0+B*y0+C*z0+D<>0) then Rezult:=2;
end;

begin
writeln('Введите координаты нормального вектора плоскости f A,B,C');
readln(A,B,C);
writeln('Введите координаты произвольной фиксированной точки l x0,y0,z0');
readln(x0,y0,z0);
writeln('координаты направляющего вектора прямой l m,n,p');
readln(m,n,p);
writeln('введите значение D');
readln(D);

rez:=Rezult(A,B,C,x0,y0,z0,m,n,p,D);
if rez=0 then writeln('l пересекает плоскость f');
if rez=1 then writeln('прямая l лежит на плоскости f');
if rez=2 then writeln('прямая l параллельная плоскости f');

end.

3 | Автор: ira_butenko97 | 2014-11-02, 13:22   |  Репутация: [ + 4 ]
http://195.208.237.170/WDE/?shared=OlgaFrolova/Лабораторная9.pas
15. Даны вершины треугольника в пространстве. Найти все три высоты треугольника.
Код
program OlgaFrolova;
           (****************************************************
      **   Laba #9 File Olga Frolova.pas == ver.1.0. **
      ***  Frolova O.R. Group I-14-1 Date 06.11.2014 ***
      ****************************************************)
var
x1,y1,z1,x2,y2,z2,x3,y3,z3,Ha,Hb,Hc:real;

Procedure height(Ax,Ay,Az,Bx,By,Bz,Cx,Cy,Cz:real; var H1,H2,H3:real);
Var a,b,c,p,F:real;
begin
  a:=sqrt(Ax*Ax+Ay*Ay+Az*Az);
b:=sqrt(Bx*Bx+By*By+Bz*Bz);
c:=sqrt(Cx*Cx+Cy*Cy+Cz*Cz);
p:=(a+b+c)/2;
F:=sqrt(p*(p-a)*(p-b)*(p-c));
H1:=(2/a)*F;
writeln ('Высота опущенная на сторону а ',H1);
H2:=(2/b)*F;
writeln ('Высота опущенная на строну b ',H2);
H3:=(2/c)*F;
writeln ('Высота опущенная на строну c ',H3);
end;

begin
writeln ('Введите координаты вершины A');
readln (x1,y1,z1);
writeln ('Введите координаты вершины B');
readln (x2,y2,z2);
writeln ('Введите координаты вершины C');
readln (x3,y3,z3);
  height(x1,y1,z1,x2,y2,z2,x3,y3,z3,Ha,Hb,Hc);
end.




25101996
4 | Автор: OlgaFrolova | 2014-11-06, 22:46   |  Репутация: [ + 0 ]
16. Даны вершины треугольной пирамиды. Найти площади всех граней.

Код
program torres;
procedure V(var x,y,z:real;st:string);
begin
writeln(st);
write('x=');read(x);
write('y=');read(y);
write('z=');read(z)
end;
function Dlina(x1,y1,z1,x2,y2,z2:real):real;
begin
Dlina:=sqrt(sqr(x2-x1)+sqr(y2-y1)+sqr(z2-z1))
end;
function S(a,b,c:real):real;
var p:real;
begin
p:=(a+b+c)/2;
S:=sqrt(p*(p-a)*(p-b)*(p-c))
end;
     
var x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,s1,s2,s3,s4: real;
begin
writeln('Введите координаты 4х вершин пирамиды:');
V(x1,y1,z1,'1 вершина');
V(x2,y2,z3,'2 вершина');
V(x3,y3,z3,'3 вершина');
V(x4,y4,z4,'4 вершина');
s1:=S(Dlina(x1,y1,z1,x2,y2,z2),Dlina(x1,y1,z1,x3,y3,z3),Dlina(x2,y2,z2,x3,y3,z3));
s2:=S(Dlina(x1,y1,z1,x2,y2,z2),Dlina(x1,y1,z1,x4,y4,z4),Dlina(x2,y2,z2,x4,y4,z4));
s3:=S(Dlina(x3,y3,z3,x2,y2,z2),Dlina(x3,y3,z3,x4,y4,z4),Dlina(x2,y2,z2,x4,y4,z4));
s4:=S(Dlina(x1,y1,z1,x3,y3,z3),Dlina(x1,y1,z1,x4,y4,z4),Dlina(x3,y3,z3,x4,y4,z4));
writeln ('Площадь первой боковой грани=',s1:0:2);
writeln ('Площадь второй боковой грани=',s2:0:2);
writeln ('Площадь третей боковой грани=',s3:0:2);
writeln ('Площадь основы=',s4:0:2);
end.



5 | Автор: torres | 2014-11-08, 20:47 | Изменено: torres - Сб, 2014-11-08, 20:49   |  Репутация: [ + 0 ]
8. Напишите программу-калькулятор, умеющую складывать, вычитать или умножать скалярно два вектора. В процедуру передавать координаты векторов и операцию.
Код
Program Mr_pozitiv;
      //('*****************************************************');
      //('*        laba #9  file: laba9.pas == ver.1.0        *');
      //('*                     exercise                      *');
      //('*   Malevanny V. A.  Group I-14-1 Date: 09/11/14    *');
      //('*****************************************************');
procedure res(x1,y1,x2,y2 :Real; k :Integer);
begin
Write('Результат:');
if k=1 then Writeln('(',x1+x2:0:2,';',y1+y2:0:2,')') else
if k=2 then Writeln('(',x1-x2:0:2,';',y1-y2:0:2,')') else
if k=3 then Writeln(x1*x2+y1*y2:0:2);
end;

var x1,x2,y1,y2 :Real; k :Integer;
begin
Writeln('Введите координаты первого вектора:');
Write('x=');
Readln(x1);
Write('y=');
Readln(y1);
Writeln('Введите координаты второго вектора:');
Write('x=');
Readln(x2);
Write('y=');
Readln(y2);
repeat
Writeln('Выберите операцию над векторами:');
Writeln('1-сложение');
Writeln('2-вычитание');
Writeln('3-скалярное произведение');
Readln(k);
until k in [1..3];
res(x1,y1,x2,y2,k);
end.


perfect ;)
6 | Автор: Mr_Pozitiv | 2014-11-09, 21:03 | Изменено: Mr_Pozitiv - Вс, 2014-11-09, 21:06   |  Репутация: [ + 6 ]

Код
procedure sbal(a,b,c,d,e:integer; var sb:real);
begin
sb:=(a+b+c+d+e)/5;
end;
const
m=3;
type
ocenka = array[1..5] of integer;
type
gruppa = record
name: string;
bal: ocenka;
end;
var a:array[1..M] of gruppa;
i,j:integer;
sb:real;
begin
for i:=1 to M do
begin
read(a[i].name);
for j:=1 to 5 do read(a[i].bal[j]);
end;
writeln('Студенты получившие  стипендию: ');
for i:=1 to M do
begin
sbal(a[i].bal[1],a[i].bal[2],a[i].bal[3],a[i].bal[4],a[i].bal[5],sb);
if sb >= 4 then writeln(a[i].name);
end;
end.


11. Для группы студентов заданы их оценки по пяти предметам. Используя записи и процедуры, написать программу, которая выводит список студентов, которым назначена стипендия. Стипендия назначается, если средний балл 4.0 и выше. Студентов оценивают по пятибальной системе.
7 | Автор: Forzorezor | 2014-11-17, 16:32   |  Репутация: [ + 4 ]
10. Даны несколько наборов координат четырех вершин четырехугольника. Написать программу, вычисляющую площадь четырехугольника.
Код

type Point=record
х,у: integer;
end;
procedure formula(х1,у1,х2,у2,х3,у3:integer;var s:real);
var a,b,c,p:real;
begin
a:=sqrt(sqr(x1-x2)+sqr(y1-y2));
b:=sqrt(sqr(x2-x3)+sqr(y2-y3));
c:=sqrt(sqr(x3-x1)+sqr(y3-y1));
p:=(a+b+c)/2;
s:=sqrt(p*(p-a)*(p-b)*(p-c));
end;
var
a: array[1..4] of Point;
s,s1,s2: real;
r: integer;
begin
for r:=1 to 3 do
with a[r] do
begin
write('Введите координаты ',r,'-й вершины: ');
readln(a[r].x,a[r].y);
end;
formula(a[1].x, a[1].y, a[2].x, a[2].y, a[3].x, a[3].y, s1);
write('Введите координаты 4-й вершины: ');
readln(a[4].x,a[4].y);
formula(a[1].x, a[1].y, a[3].x, a[3].y, a[4].x, a[4].y, s2);
s:=s1+s2;
writeln('s = ',s);
end.

8 | Автор: Awesome | 2014-11-20, 22:39   |  Репутация: [ + 2 ]
9. Напишите программу, умеющую находить высоту треугольной пирамиды, для
которой заданы координаты ее вершин. У вас задано несколько наборов
точек, задающих пирамиду.

Код
Program qwerty159;
Var a,b,c,d,x,y,z,x1,y1,z1,x2,y2,z2,x3,y3,z3,F: real;
Begin
Writeln('Введите x,y,z');
Writeln('Введите x1,y1,z1');
Writeln('Введите x2,y2,z2');
Writeln('Введите x3,y3,z3');
Readln(x,y,z);
Readln(x1,y1,z1);
Readln(x2,y2,z2);
Readln(x3,y3,z3);
a:=sqrt(sqr(x2-x3)+sqr(y2-y3)+sqr(z2-z3));
b:=sqrt(sqr(x3-x1)+sqr(y3-y1)+sqr(z3-z1));
c:=sqrt(sqr(x2-x1)+sqr(y2-y1)+sqr(z2-z1));
F:=(abs(a*x1+b*y1+c*z1+d))/(sqrt(power(a,2)+power(b,2)+power(c,2)));
Writeln('Диагональ F=',F);
end.

9 | Автор: @qwerty159 | 2014-11-25, 19:51   |  Репутация: [ + 0 ]
9 | Автор: @qwerty159 | 2014-11-25, 19:51   |  Репутация: [ + 0 ]
9. Напишите программу, умеющую находить высоту треугольной пирамиды, для
которой заданы координаты ее вершин. У вас задано несколько наборов
точек, задающих пирамиду.

Код
Program qwerty159;
Var a,b,c,d,x,y,z,x1,y1,z1,x2,y2,z2,x3,y3,z3,F: real;
Procedure height(a,b,c,d,x,y,z,x1,y1,z1,x2,y2,z2,x3,y3,z3:real; var F:real);  
Begin
a:=sqrt(sqr(x2-x3)+sqr(y2-y3)+sqr(z2-z3));
b:=sqrt(sqr(x3-x1)+sqr(y3-y1)+sqr(z3-z1));
c:=sqrt(sqr(x2-x1)+sqr(y2-y1)+sqr(z2-z1));
F:=(abs(a*x1+b*y1+c*z1+d))/(sqrt(power(a,2)+power(b,2)+power(c,2)));
Writeln('Диагональ F=',F);
end;

Begin
Writeln('Введите x,y,z');
Writeln('Введите x1,y1,z1');
Writeln('Введите x2,y2,z2');
Writeln('Введите x3,y3,z3');
Readln(x,y,z);
Readln(x1,y1,z1);
Readln(x2,y2,z2);
Readln(x3,y3,z3);
height(a,b,c,d,x,y,z,x1,y1,z1,x2,y2,z2,x3,y3,z3,F);
end.


10 | Автор: @qwerty159 | 2014-11-26, 18:18   |  Репутация: [ + 0 ]
6. Напишите программу, которая находит объем пирамиды, по заданным координатам вершин. Вам даны несколько наборов координат для разных пирамид.

Код
Program ELMpr_la9;
const n=1000;
var
   i:byte;
   S:real;
   A:array[1..n] of Integer;
   B:array[1..n] of integer;
   C:array[1..n] of integer;
   D:array[1..n] of integer;
   AB:array[1..n] of integer;
   AC:array[1..n] of integer;
   AD:array[1..n] of integer;
Procedure Vich;
   Begin
     AB[1]:=B[1]-A[1];
     AB[2]:=B[2]-A[2];
     AB[3]:=B[3]-A[3];
     AC[1]:=C[1]-A[1];
     AC[2]:=C[2]-A[2];
     AC[3]:=C[3]-A[3];
     AD[1]:=D[1]-A[1];
     AD[2]:=D[2]-A[2];
     AD[3]:=D[3]-A[3];
   End;
Procedure ReadK;
   Begin
     S:=(AB[1]*AC[2]*AD[3])+(AB[2]*AC[3]*AD[1])+(AB[3]*AC[1]*AD[2])+(AB[3]*AC[2]*AD[1])+(AB[2]*AC[1]*AD[3])+(AB[1]*AC[3]*AD[2]);
     S:=S/6;
     Writeln('S=',S);
   End;
Begin
   Writeln('Введите коородинаты вершин приамиды');
   for i:=1 to 3 do readln(A[i]);
   for i:=1 to 3 do readln(B[i]);
   for i:=1 to 3 do readln(C[i]);
   for i:=1 to 3 do readln(D[i]);
   Vich;
   ReadK;
End.



El_Magnifico with <3
11 | Автор: El_MAgnifico | 2014-11-26, 20:38 | Изменено: El_MAgnifico - Чт, 2014-11-27, 20:22   |  Репутация: [ + 8 ]
Дано несколько наборов координат вершин треугольника в пространстве. Определить тип треугольника (равносторонний, прямоугольный, тупоугольный, равнобедренный). 


Код
program bf_laba_9;

procedure vvod(var x1,y1,x2,y2,x3,y3,d1,d2,d3:real);{это процедура ввода данных в программу и вычисления длинны векторов}
begin
write('Введите x1='); readln(x1);
write('Введите y1='); readln(y1);
write('Введите x2='); readln(x2);
write('Введите y2='); readln(y2);
write('Введите x3='); readln(x3);
write('Введите y3='); readln(y3);
d1:=sqrt(sqr(x1-x2)+sqr(y1-y2));
d2:=sqrt(sqr(x1-x3)+sqr(y1-y3));
d3:=sqrt(sqr(x2-x3)+sqr(y2-y3));
end;

procedure TypTreug(d1,d2,d3:real);{Определения типа треугольника}
begin
if (d1+d2=d3) or (d1+d3=d2) or (d2+d3=d1)or (d1+d2<d3) or (d1+d3<d2) or (d2+d3<d1) Then writeln('Треугольник не существует. Попробуйте еще раз. :('); {треугольник не существует}
if (d1=d2) and (d2=d3) then writeln('Треугольник равносторонний'); {равностор}
if (d1=d2) or (d2=d3) or (d3=d1) then writeln('Треугольник равнобедренный'); {равнобедр}
if (sqr(d1)+sqr(d2)=sqr(d3)) or (sqr(d1)+sqr(d3)=sqr(d2)) or (sqr(d2)+sqr(d3)=sqr(d1)) then writeln('Треугольник прямоугольный') {прямоугольный}
end;

var x1,y1,x2,y2,x3,y3,d1,d2,d3:real; Typ,T:integer;

begin
Vvod(x1,y1,x2,y2,x3,y3,d1,d2,d3);
TypTreug(d1,d2,d3);

ReadLn;
end.

12 | Автор: Bun_Frith | 2014-11-26, 22:09   |  Репутация: [ + 4 ]
Задание № 2. Напишите программу, решающую систему линейных уравнений матричным методом. В качестве параметров в процедуру передавать коэффициенты матрицы системы и столбец свободных членов. Порядок системы не выше четырех. 


Код
Const nmax=4;
Type mas=array[1..nmax] of real;
      matr=array[1..nmax] of mas;
Var A:matr;
     b,x:mas;
     i,j,n:integer;
     flag:boolean;
Procedure Gaus(A:matr;B:mas;Var X:mas;Var flag:boolean);
Var i,j,k,imax:integer;
     temp,pr,sum:real;
Begin
     flag:=true;
     For k:=1 to n-1 do
     Begin
      imax:=k;
      For i:=k+1 to n do
       if abs(A[i][k])>abs(A[imax][k]) then imax:=i;
      if imax<>k then
      Begin
        For j:=1 to n do
        Begin
          temp:=A[k][j];
          A[k][j]:=A[imax][j];
          A[imax][j]:=temp;
        End;
        temp:=B[k];
        B[k]:=B[imax];
        B[imax]:=temp;
      End;
      For i:=k+1 to n do
      Begin
         pr:=a[i][k]/a[k][k];
         For j:=1 to n do
          a[i][j]:=a[i][j]-a[k][j]*pr;
         b[i]:=b[i]-b[k]*pr;
         if a[i][i]=0 then
         Begin
           flag:=false;
           Exit;
         End;
      End;
      End;
      x[n]:=b[n]/a[n][n];
      For k:=n-1 downto 1 do
      Begin
         sum:=0;
         For i:=k+1 to n do
          sum:=sum+x[i]*a[k][i];
         x[k]:=(b[k]-sum)/a[k][k];
      End;
End;
Begin
     Repeat
      write('Введите размерность 1<=N<=',nmax,': ');readln(n);
     Until n in [1..nmax];
     For i:=1 to n do
      For j:=1 to n do
      Begin
        write('A[',i,',',j,'] = ');
        readln(A[i][j]);
      End;
     For i:=1 to n do
     Begin
        write('B[',i,'] = ');
        readln(B[i]);
     End;
     writeln('Матрица A');
     For i:=1 to n do
     Begin
       For j:=1 to n do
        write(A[i][j]:6:2);
       writeln(' | ',B[i]:6:2);
     End;
     Gaus(A,B,X,flag);
     if flag then
     Begin
       write('X = (',X[1]:6:2);
       For i:=2 to n do
        write(';',X[i]:6:2);
       writeln('  )');
     End
     else writeln('Система вырождена');
     readln;
End.

Результат работы программы: 

13 | Автор: beznoschenko | 2014-11-26, 22:42   |  Репутация: [ + 2 ]
13 | Автор: beznoschenko | 2014-11-26, 22:42   |  Репутация: [ + 2 ]
Код
program torres;
  procedure V(var x,y,z:real;st:string);
  begin
  writeln(st);
  write('x=');read(x);
  write('y=');read(y);
  write('z=');read(z)
  end;
  function Dlina(x1,y1,z1,x2,y2,z2:real):real;
  begin
  Dlina:=sqrt(sqr(x2-x1)+sqr(y2-y1)+sqr(z2-z1))
  end;
  function S(a,b,c:real):real;
  var p:real;
  begin
  p:=(a+b+c)/2;
  S:=sqrt(p*(p-a)*(p-b)*(p-c))
  end;
        
  var x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,s1,s2,s3,s4: real;
  begin
  writeln('Введите координаты 4х вершин пирамиды:');
  V(x1,y1,z1,'1 вершина');
  V(x2,y2,z3,'2 вершина');
  V(x3,y3,z3,'3 вершина');
  V(x4,y4,z4,'4 вершина');
  s1:=S(Dlina(x1,y1,z1,x2,y2,z2),Dlina(x1,y1,z1,x3,y3,z3),Dlina(x2,y2,z2,x3,y3,z3));
  s2:=S(Dlina(x1,y1,z1,x2,y2,z2),Dlina(x1,y1,z1,x4,y4,z4),Dlina(x2,y2,z2,x4,y4,z4));
  s3:=S(Dlina(x3,y3,z3,x2,y2,z2),Dlina(x3,y3,z3,x4,y4,z4),Dlina(x2,y2,z2,x4,y4,z4));
  s4:=S(Dlina(x1,y1,z1,x3,y3,z3),Dlina(x1,y1,z1,x4,y4,z4),Dlina(x3,y3,z3,x4,y4,z4));
  writeln ('Площадь первой боковой грани=',s1:0:2);
  writeln ('Площадь второй боковой грани=',s2:0:2);
  writeln ('Площадь третей боковой грани=',s3:0:2);
  writeln ('Площадь основы=',s4:0:2);
  end.

16. Даны вершины треугольной пирамиды. Найти площади всех граней.
14 | Автор: torres | 2014-11-26, 23:16   |  Репутация: [ + 0 ]
7. Ваша программа должна вычислять векторное произведение двух векторов. У вас задано несколько пар векторов.

Код
program Iren456
{***********************************}
{* laba#9 file iren456.pas==ver1.0 *}
{* Zaznoba Irina I-14-1 26.11.14   *}{***********************************};
var
f:boolean;
k,d,m,n:array[1..3]of real;
i:integer;
Procedure ymnojenie;
var
i:integer;
f:boolean;
a,b,c,ax,bx,ay,by,az,bz:real;
d:array[1..3]of real;
begin
writeln('enter ax,ay,az');
writeln('enter bx,by,bz');
readln(ax,ay,az,bx,by,bz);
a:=(ay*bz-az*by);
b:= (az*bx-ax*bz);
c:= (ax*by-ay*bx);
d[1]:=a;
d[2]:=b;
d[3]:=c;
for i:=1 to 3 do
k[i]:=d[i];
end;
begin
f:=true;
ymnojenie;
for i:=1 to 3 do
n[i]:=k[i];
for i := 1 to 3 do
     write (n[i]:6);
writeln;
f:=false;
ymnojenie;
for i:=1 to 3 do
m[i]:=k[i];
for i := 1 to 3 do
     write (m[i]:6);
writeln
end.
http://195.208.237.170/WDE/?shared=iren4562/laba9.pas


Ирина Зазноба
15 | Автор: iren456 | 2014-11-27, 17:22 | Изменено: iren456 - Чт, 2014-11-27, 17:26   |  Репутация: [ + 0 ]
5.Напишите программу, вычисляющую значения углов в многоугольнике.
Код
Program lab9;
Uses crt;
Var s,m: real;
      n: integer;
      x,y: array[1..21] of real;
     
Procedure Vvod;
Var i: integer;
Begin
   write('Введите количество углов многоугольника n=');
   readln(n);
   for i:= 1 to n do
    begin
     writeln('Введите координаты  M ',i);
     write('x[',i,']=');
     readln(x[i]);
     write('y[',i,']=');
     readln(y[i]);
    end;
    x[n+1]:=x[1];
    y[n+1]:=y[1];
End;
     
Procedure Perenos;
Var i: integer;
Begin
   m:=y[1];
   for i:= 2 to n do
    if m >y [i]then
     m:=y[i];
    for i:=1 to n+1 do
     y[i]:=y[i]-m;
End;
     
Procedure Ploshad;
Var i: integer;
Begin
   s:=0;
   for i:= 1 to n do
    s:= s+((y[i+1]+y[i])*(x[i+1]-x[i])/2);
end;
     
Procedure Vyvod;
Begin
   writeln('Площадь многоугольника S=',abs(s):1:2);
   readln;
end;
     
Begin
   clrscr;
   Vvod;
   Perenos;
   Ploshad;
   Vyvod;
end.



Selena
16 | Автор: Selena | 2014-11-28, 20:55 | Изменено: Selena - Пт, 2014-11-28, 21:13   |  Репутация: [ + 2 ]
1. Напишите программу, которая решает систему линейных уравнений методом Гаусса. В качестве параметров в процедуру передавать коэффициенты матрицы системы и столбец свободных членов. 

Код
program dimeshion;
uses crt;
const nmax = 100;
var
   i, j,n, k: integer; h: real;
   x: array[1..nmax] of real;
type
   matr = array[1..nmax, 1..nmax] of real;
   vect = array[1..nmax] of real;

procedure matrix(var m: matr; var v: vect);
begin
   for i := 1 to n do begin
     writeln('Уравнение:', i);
     for j := 1 to n do begin
       write('Введите A(', i, ',', j, '):');
       readln(m[i, j]);
     end;
     write('Свободный член: B(', i, '):');
     readln(v[i]);
   end;
end;
var
g: matr; f: vect;
BEGIN
clrscr;
writeln('Количество уравнений: ');
readln(n);
matrix(g,f);
   for i := 1 to n do
   begin
     for j := i + 1 to n do
     begin
       g[j, i] := -g[j, i] / g
       [i, i];
       for k := i + 1 to n do
         g[j, k] := g
         [j, k] + g[j, i] * g[i, k];
       f [j]:= f [j]+ g[j, i] * f[i];
     end;
   end;
   x [n]:= f [n]/ g[n, n];
   for i := n - 1 downto 1 do
   begin
     h := f[i];
     for j := I + 1 to n do
       h := h - x [j]* g[i, j];
     x [i]:= h / g[i, i];
   end;
   writeln('Решение системы:');
   for i := 1 to n do begin
     writeln('X (', i, ')=', x[i]:3:5);
   readln;
end;
END.


17 | Автор: dimeshion | 2014-11-28, 23:31   |  Репутация: [ + 2 ]
Код
program Bonyasik;
  type Ved=record
        fam:string;
        t,z:real;
       end;
  var str:Ved; fam:string;

  procedure zarpl;
  const n=5;
  var s,m,l:real; f,k,i,j:integer;
      Z:array[1..n] of real; T:array[1..n] of real;
  begin
  randomize;
  writeln('Заработок за месяц:');
    for i:=1 to n do begin
     z[i]:=random(2001);
     writeln(z[i]:5); end;
   writeln('Кол-во отработаных часов:');
    for j:=1 to n do begin
     t[j]:=random(101);
     writeln(t[j]:5); end;
   s:=0; m:=0;
   for f:=1 to n do begin
    s:=s+z[f]; end;
   for k:=1 to n do begin
    m:=m+t[k]; end;
  l:=trunc(s/m);
  writeln('Средняя зарплата за день:',l);
  end;
   
  begin
   writeln('Фамилии работников:');
   readln(fam);
   zarpl;
   end.


http://195.208.237.170/WDE/?shared=Bonyasik/Bonyasik9.pas
18 | Автор: Бонясик | 2014-12-09, 15:58   |  Репутация: [ + 0 ]
Форум ПРОГРАММИСТОВ » КУРС ОПР - ПАСКАЛЬ » Лабораторные работы » Лабораторная работа №9 (Процедуры и функции)
  • Страница 1 из 1
  • 1
Поиск: