Program Kursovaya_rabota;
Uses crt,graph;
Const
maxn = 10;
Type
Data = Real;
Matrix = Array[1..maxn, 1..maxn] of Data;
Vector = Array[1..maxn] of Data;
{ Процедура ввода расширенной матрицы системы }
Procedure ReadSystem(n: Integer; var a,a1: Matrix; var b,b1: Vector);
Var
i, j, r: Integer;
Begin
r:=WhereY;
GotoXY(2, r);
Write('A');
For i := 1 to n do
Begin
GotoXY(i*6+2, r);
Write(i);
GotoXY(1, r+i+1);
Write(i:2);
End;
GotoXY((n+1)*6+2, r);
Write('b');
For i := 1 to n do
Begin
For j := 1 to n do
Begin
GotoXY(j * 6 + 2, r + i + 1);
Read(a[i, j]);
End;
GotoXY((n + 1) * 6 + 2, r + i + 1);
Read(b[i]);
End;
For i:=1 to n do
Begin
B1[i]:=B[i];
For j:=1 to n do
A1[i,j]:=A[i,j];
End;
End;
{ Процедура вывода результатов }
Procedure WriteX(n:Integer; x:Vector);
Var
i: Integer;
Begin
For i := 1 to n do
Writeln('x', i, ' = ', x[i]:8:5);
Readln;
End;
{ Функция, реализующая метод Гаусса }
Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;
Var
i, j, k, l: Integer;
q, m, t: Data;
Begin
For k := 1 to n - 1 do
Begin
{ Ищем строку l с максимальным элементом в k-ом столбце}
l := 0;
m := 0;
For i := k to n do
If Abs(a[i, k]) > m then
Begin
m := Abs(a[i, k]);
l := i;
End;
{ Если у всех строк от k до n элемент в k-м столбце нулевой, то система не имеет однозначного решения }
If l = 0 then
Begin
Gauss := false;
Exit;
End;
{ Меняем местами l-ую строку с k-ой }
If l <> k then
Begin
For j := 1 to n do
Begin
t := a[k, j];
a[k, j] := a[l, j];
a[l, j] := t;
End;
t := b[k];
b[k] := b[l];
b[l] := t;
End;
For i:=k+1 to n do
For j:=1 to n do
If (a[k,j]=a[I,j]) and (b[k]=b[i]) then
Begin
Gauss:=false;
Exit;
End;
{ Преобразуем матрицу }
For i := k + 1 to n do
Begin
q := a[i, k] / a[k, k];
For j := 1 to n do
If j = k then
a[i, j] := 0
else
a[i, j] := a[i, j] - q * a[k, j];
b[i] := b[i] - q * b[k];
End;
End;
{ Вычисляем решение }
x[n] := b[n] / a[n, n];
For i := n - 1 downto 1 do
Begin
t := 0;
For j := i+1 to n do
t := t + a[i,j] * x[j];
x[i] := (b[i] - t)/a[i, i];
End;
Gauss := true;
End;
{Построение зависимости xk от xl для каждого уравнения}
Procedure zavishit(n,k,l:integer; var a1:matrix; b1,x:vector);
Var
i,j:integer;
S:real;
Begin
For i:=1 to n do
Begin
S:=b1[i];
For j:=1 to n do
If (j<>k) and (j<>l) then
S:=s-a1[i,j]*x[j];
Writeln('Uravnenie',I,' zavishit X',k,' ,X',l,' : ',a1[I,k]:5:3,' *X',k,' +',a1[I,l]:5:3,' *X',l,' = ',s:5:3);
End;
End;
{Построение графика зависимости хк от хl для каждого уравнения}
Procedure graphik(n,k,l:integer; var a1:matrix; b1,x:vector);
Var
i,j,gd,gm,xk1,xk2,xl1,xl2:integer;
S:real;
Begin
For i:=1 to n do
Begin
S:=b1[i];
For j:=1 to n do
If (j<>k) and (j<>l) then
S:=s-a1[i,j]*x[j];
Writeln('Graphik zavisimosti X',k,' ot X',l,' dlya uravneniya ',i);
Readln;
Clrscr;
{Построение оси 0х, 0у}
Gd:=detect;
Initgraph(gd,gm,'');
Setbkcolor(black);
Setcolor(blue);
Begin
Line(100,300,400,300);
Moveto(400,300); Moverel(-10,10);
Linerel(10,-10); Moverel(-10,-10); Linerel (10,10);
End;
Begin
Line(200,400,200,100);
Moveto(200,100); Moverel(-10,10);
Linerel(10,-10); Moverel(10,10); Linerel (-10,-10);
End;
{Построение линий}
Xk1:=0; xl1:=round((s-a1[I,k]*xk1)/a1[I,l]);
Xk2:=100; xl2:=round((s-a1[I,k]*xk2)/a1[I,l]);
Setcolor(white);
Line(xk1+200,300-xl1,xk2+200,300-xl2);
Readln;
End;
End;
{Главная программа}
Var
n, I,k,l,f: Integer;
a,a1: Matrix ;
b, b1,x: Vector;
Begin
Repeat
ClrScr;
Writeln ('Federalnoe agenstvo po obrazovaniu');
Writeln;
Writeln ('Tulskiy gosudarstvenniy universitet');
Writeln;
Writeln ('KAFEDRA RADIOELEKTRONIKI');
Writeln; Writeln; Writeln;
Writeln ('Kursovaya rabota');
Writeln;
Writeln('RESHENIE SISTEMI LINEYNIH ALGEBRAICHESKIH URAVNENIY METODOM GAUSSA');
Writeln;
Writeln ('Razrabotal student gr. 120691 Zhurin Dmitry Vladimirovich.');
Writeln;
Writeln ('Tula 2010 g.');
Writeln;Writeln;
Writeln ('___________________________________________');
Writeln;
Writeln ('Dlya prodolzhenia raboti nazhmite klavishu Enter');
Readln;
Clrscr;
Writeln('Progamma reshenia sistemi lineynih algebraicheskih uravneniy metodom Gaussa');
Writeln;
Repeat
Writeln('Vvedite poryadok matritsi sistemi (max. 10)');
Write('n=');
Read(n);
Until (n >= 2) and (n <= maxn);
Writeln;
Writeln('Vvedite rashirennuyu matritsu sistemi');
ReadSystem(n, a,a1, b,b1);
Writeln;
If Gauss(n, a, b, x) then
Begin
Writeln('Rezultat vichisleniy po metodu Gaussa');
WriteX(n, x);
Writeln ('Dlya prodolzhenia raboti nazhmite klavishu Enter');
Readln;
Clrscr;
Repeat
Writeln('Vvedite poryadok k,l peremennih Xk, Xl');
Write('k=');
Read(k);
Write('l=');
Read(l);
Until (k>=1) and (k<=n) and (l>=1) and (l<=n) and (k<>l);
Zavishit(n,k,l,a1,b1,x);
Readln;
Writeln ('Dlya prodolzhenia raboti nazhmite klavishu Enter');
Readln;
Clrscr;
Graphik(n,k,l,a1,b1,x);
Readln;
Writeln ('Dlya prodolzhenia raboti nazhmite klavishu Enter');
Readln;
End
else
Writeln('Dannuyu sistemu nevozmojno reshit metodom Gaussa');
Readln;
Writeln('Hotite povtorit? (yes-1 /no-0)');
Readln(f);
Until f=0;
End.
