прикладная математика

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.