fork download
copy 
  1. program SolveLinearSystem;
  2.  
  3. uses
  4.   SysUtils;
  5.  
  6. type
  7.   TMatrix = array[1..4, 1..4] of Real;
  8.   TVector = array[1..4] of Real;
  9.  
  10. function SolveSystem(A: TMatrix; b: TVector; var x: TVector): Boolean;
  11. var
  12.   i, j, k: Integer;
  13.   factor, sum: Real;
  14. begin
  15.   // Метод Гаусса
  16.   for k := 1 to 3 do
  17.   begin
  18.     for i := k + 1 to 4 do
  19.     begin
  20.       factor := A[i, k] / A[k, k];
  21.       for j := k to 4 do
  22.         A[i, j] := A[i, j] - factor * A[k, j];
  23.       b[i] := b[i] - factor * b[k];
  24.     end;
  25.   end;
  26.  
  27.   // Зворотний хід
  28.   x[4] := b[4] / A[4, 4];
  29.   for i := 3 downto 1 do
  30.   begin
  31.     sum := 0;
  32.     for j := i + 1 to 4 do
  33.       sum := sum + A[i, j] * x[j];
  34.     x[i] := (b[i] - sum) / A[i, i];
  35.   end;
  36.  
  37.   SolveSystem := True;
  38. end;
  39.  
  40. var
  41.   A: TMatrix;
  42.   b, x: TVector;
  43.   i: Integer;
  44.  
  45. begin
  46.   // Заповнення матриці A та вектора b
  47.   A[1, 1] := 17.3; A[1, 2] := -18.89; A[1, 3] := -1.59; A[1, 4] := 0;
  48.   A[2, 1] := 0; A[2, 2] := 1.59; A[2, 3] := 5.89; A[2, 4] := 3.6;
  49.   A[3, 1] := 10.4; A[3, 2] := 27.7; A[3, 3] := -4.3; A[3, 4] := 0;
  50.   A[4, 1] := 27.7; A[4, 2] := 10.4; A[4, 3] := 0; A[4, 4] := 3.6;
  51.  
  52.   b[1] := 11.9; b[2] := 4.61; b[3] := -21.1; b[4] := -0.1;
  53.  
  54.   // Розв'язання системи
  55.   if SolveSystem(A, b, x) then
  56.   begin
  57.     Writeln('Розв''язок системи:');
  58.     for i := 1 to 4 do
  59.       Writeln('x[', i, '] = ', x[i]:0:3); // Виведення з трьома знаками після коми
  60.   end
  61.   else
  62.     Writeln('Система не має розв''язку.');
  63.  
  64.   Readln; // Затримка консолі
  65. end.
Success #stdin #stdout 0s 5288KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Розв'язок системи:
x[1] = 34994851121385.195
x[2] = 16161827387056.279
x[3] = 188750946577647.060
x[4] = -315955661357710.000
https://ideone.com/KLIxtk
language:
Pascal (fpc 3.0.4)
created:
8 days 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!