fork download
copy 
  1. program QuadraticFit;
  2.  
  3. uses
  4.   SysUtils;
  5.  
  6. const
  7.   N = 25; // Количество точек данных
  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.     m := k;
  23.     for i := k + 1 to 6 do
  24.       if Abs(Matrix[i,k]) > Abs(Matrix[m,k]) then
  25.         m := i;
  26.  
  27.     // Перестановка строк
  28.     if m <> k then
  29.       for j := k to 7 do
  30.       begin
  31.         Temp := Matrix[k,j];
  32.         Matrix[k,j] := Matrix[m,j];
  33.         Matrix[m,j] := Temp;
  34.       end;
  35.  
  36.     // Исключение переменной
  37.     for i := k + 1 to 6 do
  38.     begin
  39.       if Matrix[k,k] <> 0 then // Проверка на деление на ноль
  40.       begin
  41.         Temp := Matrix[i,k] / Matrix[k,k];
  42.         for j := k to 7 do
  43.           Matrix[i,j] := Matrix[i,j] - Temp * Matrix[k,j];
  44.       end else 
  45.       begin
  46.         Writeln('Ошибка: Деление на ноль при исключении переменной.');
  47.         Exit; // Завершение программы при ошибке деления на ноль.
  48.       end;
  49.     end;
  50.   end;
  51.  
  52.   // Обратный ход
  53.   for i := 6 downto 1 do
  54.   begin
  55.     Solution[i] := Matrix[i,7];
  56.     for j := i + 1 to 6 do
  57.       Solution[i] := Solution[i] - Matrix[i,j] * Solution[j];
  58.  
  59.     if Matrix[i,i] <> 0 then // Проверка на деление на ноль при обратном ходе.
  60.       Solution[i] := Solution[i] / Matrix[i,i]
  61.     else 
  62.     begin
  63.       Writeln('Ошибка: Деление на ноль при обратном ходе.');
  64.       Exit; // Завершение программы при ошибке деления на ноль.
  65.     end;
  66.   end;
  67. end;
  68.  
  69. var 
  70.    x, y, z: array[1..N] of Double; 
  71.    Sx, Sy, Sz, Sx2, Sy2, Sxy, Sxz, Syz: Double; 
  72.    Sx3, Sy3, Sx2y, Sxy2, Sx4: Double; 
  73.    A,B,C,D,E,F: Double; 
  74.    Matrix: TMatrix; 
  75.    Solution: TVector; 
  76.    i: Integer;
  77.  
  78. begin 
  79.    // Инициализация данных (пример значений)
  80.    for i := 1 to N do 
  81.    begin 
  82.      x[i] := (i - 1) div 5; // Пример значений для x (0-4)
  83.      y[i] := (i - 1) mod 5; // Пример значений для y (0-4)
  84.      z[i] := (5 * x[i]*x[i]) + (4 * y[i]*y[i]) + (3 * x[i]*y[i]) + (2 * x[i]) + (1 * y[i]); // Пример значений для z с заданными коэффициентами A=5 B=4 C=3 D=2 E=1 F=0.
  85.    end;
  86.  
  87.    // Обнуление всех сумм 
  88.    Sx:=0; Sy:=0; Sz:=0; Sx2:=0; Sy2:=0; Sxy:=0; Sxz:=0; Syz:=0;
  89.    Sx3:=0; Sy3:=0; Sx2y:=0; Sxy2:=0; Sx4:=0;
  90.  
  91.    // Вычисление всех необходимых сумм 
  92.    for i:=1 to N do 
  93.    begin 
  94.      Sx += x[i]; 
  95.      Sy += y[i]; 
  96.      Sz += z[i]; 
  97.      Sx2 += x[i]*x[i]; 
  98.      Sy2 += y[i]*y[i]; 
  99.      Sxy += x[i]*y[i]; 
  100.      Sxz += x[i]*z[i]; 
  101.      Syz += y[i]*z[I];
  102.  
  103.      Sx3 += x[I]*x[I]*x[I]; 
  104.      Sy3 += y[I]*y[I]*y[I]; 
  105.  
  106.      Sx2y += x[I]*x[I]*y[I]; 
  107.      Sxy2 += x[I]*y[I]*y[I];
  108.  
  109.      Sx4 += x[I]*x[I]*x[I]*x[I];
  110.    end;
  111.  
  112.    // Формирование системы уравнений  
  113.    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 ;
  114.    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 ;
  115.    Matrix[3][1]:=Sy ;      Matrix[3][2]:=Sxy ;      Matrix[3][3]:=Sy2 ;     	Matrix[3][4]:=Sxy2 ;    	Matrix[3][5]:=Sy3 ;     	Matrix[3][6]:=Sxz ;      	Matrix[3][7]:=Syz ;
  116.  
  117.    // Решение системы  
  118.    SolveLinearSystem(Matrix,Solution);
  119.  
  120.    // Присвоение коэффициентов  
  121.    A:=Solution[1];  
  122.    B:=Solution[2];  
  123.    C:=Solution[3];  
  124.    D:=Solution[4];
  125.    E:=Solution[5];
  126.    F:=Solution[6];
  127.  
  128.    // Вывод результатов с большей точностью  
  129.    Writeln('Коэффициенты квадратичной модели:');  
  130.    Writeln('A = ', A:0:6);  
  131.    Writeln('B = ', B:0:6);  
  132.    Writeln('C = ', C:0:6);  
  133.    Writeln('D = ', D:0:6);  
  134.    Writeln('E = ', E:0:6);  
  135.    Writeln('F = ', F:0:6);  
  136.  
  137. end.
Success #stdin #stdout 0s 5316KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Ошибка: Деление на ноль при исключении переменной.
Коэффициенты квадратичной модели:
A = 0.000000
B = 0.000000
C = 0.000000
D = 0.000000
E = 0.000000
F = 0.000000
https://ideone.com/S9kMh2
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!