fork download 
  1. program LinearSystemSolver;
  2.  
  3. uses
  4.   SysUtils;
  5.  
  6. type
  7.   TMatrix = array[1..6, 1..7] of Double; // 6x7 матрица (6 уравнений с 7 коэффициентами)
  8.   TVector = array[1..6] of Double;       // Вектор из 6 элементов
  9.  
  10. procedure SolveLinearSystem(var Matrix: TMatrix; var Solution: TVector);
  11. var
  12.   i, j, k, m: Integer;
  13.   Temp: Double;
  14. begin
  15.   // Метод Гаусса с выбором главного элемента
  16.   for k := 1 to 6 do
  17.   begin
  18.     // Выбор главного элемента
  19.     m := k;
  20.     for i := k + 1 to 6 do
  21.       if Abs(Matrix[i, k]) > Abs(Matrix[m, k]) then
  22.         m := i;
  23.  
  24.     // Перестановка строк
  25.     if m <> k then
  26.       for j := k to 7 do
  27.       begin
  28.         Temp := Matrix[k, j];
  29.         Matrix[k, j] := Matrix[m, j];
  30.         Matrix[m, j] := Temp;
  31.       end;
  32.  
  33.     // Исключение переменной
  34.     for i := k + 1 to 6 do
  35.     begin
  36.       if Matrix[k, k] = 0 then 
  37.       begin
  38.         Writeln('Ошибка: деление на ноль в строке ', k);
  39.         Exit; // Завершить выполнение процедуры при ошибке деления на ноль.
  40.       end;
  41.  
  42.       Temp := Matrix[i, k] / Matrix[k, k];
  43.       for j := k to 7 do
  44.         Matrix[i, j] := Matrix[i, j] - Temp * Matrix[k, j];
  45.     end;
  46.   end;
  47.  
  48.   // Обратный ход
  49.   for i := 6 downto 1 do
  50.   begin
  51.     Solution[i] := Matrix[i, 7];
  52.     for j := i + 1 to 6 do
  53.       Solution[i] := Solution[i] - Matrix[i, j] * Solution[j];
  54.  
  55.     if Matrix[i, i] = 0 then 
  56.     begin
  57.       Writeln('Ошибка: деление на ноль при обратном ходе для строки ', i);
  58.       Exit; // Завершить выполнение процедуры при ошибке деления на ноль.
  59.     end;
  60.  
  61.     Solution[i] := Solution[i] / Matrix[i, i];
  62.   end;
  63. end;
  64.  
  65. var 
  66.    A: TMatrix;
  67.    B: TVector;
  68.    i,j: Integer;
  69.  
  70. begin 
  71.    // Пример заполнения матрицы (замените на ваши данные)
  72.    A[1][1] := 2; A[1][2] := -1; A[1][3] := -2; A[1][4] := -3; A[1][5] := -4; A[1][6] := -5; A[1][7] := -10;
  73.    A[2][1] := -3; A[2][2] := -2; A[2][3] := -3; A[2][4] := -4; A[2][5] := -5; A[2][6] := -6; A[2][7] := -12;
  74.    A[3][1] := -4; A[3][2] := -3; A[3][3] := -4; A[3][4] := -5; A[3][5] := -6; A[3][6] := -7; A[3][7] := -14;
  75.    A[4][1] := -5; A[4][2] := -4; A[4][3] := -5; A[4][4] := -6; A[4][5] := -7; A[4][6] := -8; A[4][7] := -16;
  76.    A[5][1] := -6; A[5][2] := -5; A[5][3]:=0.0 ;A [5 ][4]:=0.0 ;A [5 ][5]:=0.0 ;A [5 ][6]:=0.0 ;A [5 ][7]:=0.0 ;
  77.    A [6 ][1]:=0.0 ;A [6 ][2]:=0.0 ;A [6 ][3]:=0.0 ;A [6 ][4]:=0.0 ;A [6 ][5]:=0.0 ;A [6 ][6]:=0.0 ;A [6 ][7]:=0.0 ;
  78.  
  79.    SolveLinearSystem(A,B);
  80.  
  81.    Writeln('Решение системы уравнений:');
  82.    for i:=1 to Length(B) do 
  83.      Writeln('x',i,' = ', B[i]:0:2);
  84. end.
Success #stdin #stdout 0s 5312KB
comments (?)
stdin 
Standard input is empty
stdout 
Ошибка: деление на ноль при обратном ходе для строки 6
Решение системы уравнений:
x1 = 0.00
x2 = 0.00
x3 = 0.00
x4 = 0.00
x5 = 0.00
x6 = 0.00
https://ideone.com/6LzsOJ
language:
Pascal (fpc 3.0.4)
created:
18 hours ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!