fork download
copy 
  1. program QuadraticFit;
  2.  
  3. uses
  4.   SysUtils, Math;
  5.  
  6. const
  7.   N = 25; // 5x5 точек данных
  8.  
  9. type
  10.   TMatrix = array[1..6, 1..7] of Double;
  11.   TVector = array[1..6] of Double;
  12.  
  13. procedure SolveLinearSystem(var Matrix: TMatrix; var Solution: TVector);
  14. var
  15.   i, j, k, m: Integer;
  16.   Temp: Double;
  17. begin
  18.   // Метод Гаусса для решения СЛАУ
  19.   for k := 1 to 6 do
  20.   begin
  21.     // Поиск ведущего элемента
  22.     for j := k to 6 do
  23.     begin
  24.       if Abs(Matrix[j, k]) > Abs(Matrix[k, k]) then
  25.       begin
  26.         for m := 1 to 7 do
  27.         begin
  28.           Temp := Matrix[k, m];
  29.           Matrix[k, m] := Matrix[j, m];
  30.           Matrix[j, m] := Temp;
  31.         end;
  32.       end;
  33.     end;
  34.  
  35.     // Нормировка строки
  36.     Temp := Matrix[k, k];
  37.     for j := k to 7 do
  38.       Matrix[k, j] := Matrix[k, j] / Temp;
  39.  
  40.     // Исключение переменной
  41.     for i := 1 to 6 do
  42.     begin
  43.       if (i <> k) then
  44.       begin
  45.         Temp := Matrix[i, k];
  46.         for j := k to 7 do
  47.           Matrix[i, j] := Matrix[i, j] - Temp * Matrix[k, j];
  48.       end;
  49.     end;
  50.   end;
  51.  
  52.   // Получение решения
  53.   for k := 1 to 6 do
  54.     Solution[k] := Matrix[k, 7];
  55. end;
  56.  
  57. var
  58.   x, y, z: array[1..N] of Double;
  59.   Sx, Sy, Sz, Sx2, Sy2, Sxy, Sxz, Syz, Sx2y, Sxy2, Sx3, Sy3, Sx2y2, Sx4, Sy4: Double;
  60.   Sx3y, Sxy3, Sx2z, Sxyz, Sy2z: Double; // Добавлены недостающие переменные
  61.   A, B, C, D, E, F: Double;
  62.   Matrix: TMatrix;
  63.   Solution: TVector;
  64.   i: Integer;
  65. begin
  66.   // Инициализация данных (вручную заполняем массив)
  67.   // Для x=0, y=1..5
  68.   x[1] := 0; y[1] := 1; z[1] := 8;
  69.   x[2] := 0; y[2] := 2; z[2] := 11;
  70.   x[3] := 0; y[3] := 3; z[3] := 14;
  71.   x[4] := 0; y[4] := 4; z[4] := 17;
  72.   x[5] := 0; y[5] := 5; z[5] := 20;
  73.  
  74.   // Для x=1, y=1..5
  75.   x[6] := 1; y[6] := 1; z[6] := 15;
  76.   x[7] := 1; y[7] := 2; z[7] := 19;
  77.   x[8] := 1; y[8] := 3; z[8] := 23;
  78.   x[9] := 1; y[9] := 4; z[9] := 27;
  79.   x[10] := 1; y[10] := 5; z[10] := 31;
  80.  
  81.   // Для x=2, y=1..5
  82.   x[11] := 2; y[11] := 1; z[11] := 26;
  83.   x[12] := 2; y[12] := 2; z[12] := 31;
  84.   x[13] := 2; y[13] := 3; z[13] := 36;
  85.   x[14] := 2; y[14] := 4; z[14] := 41;
  86.   x[15] := 2; y[15] := 5; z[15] := 46;
  87.  
  88.   // Для x=3, y=1..5
  89.   x[16] := 3; y[16] := 1; z[16] := 41;
  90.   x[17] := 3; y[17] := 2; z[17] := 47;
  91.   x[18] := 3; y[18] := 3; z[18] := 53;
  92.   x[19] := 3; y[19] := 4; z[19] := 59;
  93.   x[20] := 3; y[20] := 5; z[20] := 65;
  94.  
  95.   // Для x=4, y=1..5
  96.   x[21] := 4; y[21] := 1; z[21] := 60;
  97.   x[22] := 4; y[22] := 2; z[22] := 67;
  98.   x[23] := 4; y[23] := 3; z[23] := 74;
  99.   x[24] := 4; y[24] := 4; z[24] := 81;
  100.   x[25] := 4; y[25] := 5; z[25] := 88;
  101.  
  102.   // Вычисление сумм для МНК
  103.   Sx := 0; Sy := 0; Sz := 0;
  104.   Sx2 := 0; Sy2 := 0; Sxy := 0;
  105.   Sxz := 0; Syz := 0;
  106.   Sx2y := 0; Sxy2 := 0;
  107.   Sx3 := 0; Sy3 := 0;
  108.   Sx2y2 := 0; Sx4 := 0; Sy4 := 0;
  109.   Sx3y := 0; Sxy3 := 0; Sx2z := 0; Sxyz := 0; Sy2z := 0;
  110.  
  111.   for i := 1 to N do
  112.   begin
  113.     Sx := Sx + x[i];
  114.     Sy := Sy + y[i];
  115.     Sz := Sz + z[i];
  116.     Sx2 := Sx2 + x[i] * x[i];
  117.     Sy2 := Sy2 + y[i] * y[i];
  118.     Sxy := Sxy + x[i] * y[i];
  119.     Sxz := Sxz + x[i] * z[i];
  120.     Syz := Syz + y[i] * z[i];
  121.     Sx2y := Sx2y + x[i] * x[i] * y[i];
  122.     Sxy2 := Sxy2 + x[i] * y[i] * y[i];
  123.     Sx3 := Sx3 + x[i] * x[i] * x[i];
  124.     Sy3 := Sy3 + y[i] * y[i] * y[i];
  125.     Sx2y2 := Sx2y2 + x[i] * x[i] * y[i] * y[i];
  126.     Sx4 := Sx4 + x[i] * x[i] * x[i] * x[i];
  127.     Sy4 := Sy4 + y[i] * y[i] * y[i] * y[i];
  128.     Sx3y := Sx3y + x[i] * x[i] * x[i] * y[i];
  129.     Sxy3 := Sxy3 + x[i] * y[i] * y[i] * y[i];
  130.     Sx2z := Sx2z + x[i] * x[i] * z[i];
  131.     Sxyz := Sxyz + x[i] * y[i] * z[i];
  132.     Sy2z := Sy2z + y[i] * y[i] * z[i];
  133.   end;
  134.  
  135.   // Формирование матрицы системы уравнений
  136.   Matrix[1, 1] := N;    Matrix[1, 2] := Sx;   Matrix[1, 3] := Sy;   Matrix[1, 4] := Sx2;  Matrix[1, 5] := Sxy;  Matrix[1, 6] := Sy2;  Matrix[1, 7] := Sz;
  137.   Matrix[2, 1] := Sx;   Matrix[2, 2] := Sx2;  Matrix[2, 3] := Sxy;  Matrix[2, 4] := Sx3;  Matrix[2, 5] := Sx2y; Matrix[2, 6] := Sxy2; Matrix[2, 7] := Sxz;
  138.   Matrix[3, 1] := Sy;   Matrix[3, 2] := Sxy;  Matrix[3, 3] := Sy2;  Matrix[3, 4] := Sxy2; Matrix[3, 5] := Sy3;  Matrix[3, 6] := Sy3;  Matrix[3, 7] := Syz;
  139.   Matrix[4, 1] := Sx2;  Matrix[4, 2] := Sx3;  Matrix[4, 3] := Sx2y; Matrix[4, 4] := Sx4;  Matrix[4, 5] := Sx3y; Matrix[4, 6] := Sx2y2; Matrix[4, 7] := Sx2z;
  140.   Matrix[5, 1] := Sxy;  Matrix[5, 2] := Sx2y; Matrix[5, 3] := Sxy2; Matrix[5, 4] := Sx3y; Matrix[5, 5] := Sx2y2; Matrix[5, 6] := Sxy3; Matrix[5, 7] := Sxyz;
  141.   Matrix[6, 1] := Sy2;  Matrix[6, 2] := Sxy2; Matrix[6, 3] := Sy3;  Matrix[6, 4] := Sx2y2; Matrix[6, 5] := Sxy3; Matrix[6, 6] := Sy4;  Matrix[6, 7] := Sy2z;
  142.  
  143.   // Решение системы
  144.   SolveLinearSystem(Matrix, Solution);
  145.  
  146.   A := Solution[1];
  147.   B := Solution[2];
  148.   C := Solution[3];
  149.   D := Solution[4];
  150.   E := Solution[5];
  151.   F := Solution[6];
  152.  
  153.   // Вывод результатов
  154.   Writeln('Коэффициенты функции F(x, y) = A + Bx + Cy + Dx² + Exy + Fy²:');
  155.   Writeln('A = ', FormatFloat('0.00', A));
  156.   Writeln('B = ', FormatFloat('0.00', B));
  157.   Writeln('C = ', FormatFloat('0.00', C));
  158.   Writeln('D = ', FormatFloat('0.00', D));
  159.   Writeln('E = ', FormatFloat('0.00', E));
  160.   Writeln('F = ', FormatFloat('0.00', F));
  161. end.
Success #stdin #stdout 0s 5288KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Коэффициенты функции F(x, y) = A + Bx + Cy + Dx² + Exy + Fy²:
A = -52.57
B = 8.43
C = 45.39
D = 2.00
E = -0.48
F = -6.33
https://ideone.com/2496Ei
language:
Pascal (fpc 3.0.4)
created:
6 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!