program kkr;
uses crt;
const e=0.000001;//поскольку числа вещественные, при проверке точно не сойдется, поэтому вводим погрешность расчетов
var a:array[1..10,1..10] of real;//масив коэфф. и св. членов
    b:array[1..10] of real;//массив свободных членов
    x:array[1..10] of real;  //массив корней уравнения
    n,i,j,k:integer;z,r,g:real;
begin
clrscr;
writeln('n= ');
readln(n);
writeln('Введите коэффициенты системы и свободные члены');
for i:=1 to n do
Begin
 For j:=1 to n do
  begin
    writeln('a[',i,',',j,']= ');
    readln(a[i,j]);
  end;
    Writeln('b[',i,']= ');
    readln(b[i]);
  end;
for k:=1 to n do //прямой ход Гаусса, приведение матрицы коэффициентов к треугольному виду
     begin
       for j:=k+1 to n do
          begin
            r:=a[j,k]/a[k,k];
            for i:=k to n do
               begin
                 a[j,i]:=a[j,i]-r*a[k,i];
               end;
            b[j]:=b[j]-r*b[k];
          end;
     end;
for k:=n downto 1 do //обратный ход Гаусса, вычисление корней
     begin
       r:=0;
       for j:=k+1 to n do
         begin
           g:=a[k,j]*x[j];
           r:=r+g;
         end;
      x[k]:=(b[k]-r)/a[k,k];
     end;
writeln('Корни системы:');
for i:=1 to n do
write('x[',i,']=',x[i]:0:2,'   ');
readln;
end.

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.

      Writeln('Graphik zavisimosti X',k,' ot X',l,' dlya uravneniya ',i);
      Readln;

{Построение графика зависимости хк от хl для каждого уравнения}

Procedure graphik(n,k,l:integer; a1:matrix; b1,x:vector);
Var
  i,j,gd,gm,xk1,xk2,xl1,xl2:integer;
  S:real;