fork download 
  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: array[1..N] of Double; 
  71.    z: array[1..N] of Double; 
  72.    Sx, Sy, Sz, Sx2, Sy2, Sxy: 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;
  89.  
  90.    // Вычисление всех необходимых сумм 
  91.    for i:=1 to N do 
  92.    begin 
  93.      Sx += x[i]; 
  94.      Sy += y[i]; 
  95.      Sz += z[i]; 
  96.      Sx2 += x[i]*x[i]; 
  97.      Sy2 += y[i]*y[i]; 
  98.      Sxy += x[i]*y[i]; 
  99.    end;
  100.  
  101.    // Формирование системы уравнений  
  102.    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 ;
  103.    Matrix[2][1]:=Sx ;      Matrix[2][2]:=Sx2 ;      Matrix[2][3]:=Sxy ;     	Matrix[2][4]:=Sx*Sx ;    	Matrix[2][5]:=Sxy ;    	Matrix[2][6]:=Sy*Sx ;    	Matrix[2][7]:=Sz ;
  104.    Matrix[3][1]:=Sy ;      Matrix[3][2]:=Sxy ;      Matrix[3][3]:=Sy2 ;     	Matrix[3][4]:=Sy*Sx ;    	Matrix[3][5]:=Sy*Sy ;    	Matrix[3][6]:=Sz ;      	Matrix[3][7]:=Sz ;
  105.  
  106.    // Решение системы  
  107.    SolveLinearSystem(Matrix,Solution);
  108.  
  109.    // Присвоение коэффициентов  
  110.    A:=Solution[1];  
  111.    B:=Solution[2];  
  112.    C:=Solution[3];  
  113.    D:=Solution[4];
  114.    E:=Solution[5];
  115.    F:=Solution[6];
  116.  
  117.    // Вывод результатов с большей точностью  
  118.    Writeln('Коэффициенты квадратичной модели:');  
  119.    Writeln('A = ', A:0:6);  
  120.    Writeln('B = ', B:0:6);  
  121.    Writeln('C = ', C:0:6);  
  122.    Writeln('D = ', D:0:6);  
  123.    Writeln('E = ', E:0:6);  
  124.    Writeln('F = ', F:0:6);  
  125.  
  126. end.
Success #stdin #stdout 0s 5300KB
comments (?)
stdin 
Standard input is empty
stdout 
Ошибка: Деление на ноль при исключении переменной.
Коэффициенты квадратичной модели:
A = 0.000000
B = 0.000000
C = 0.000000
D = 0.000000
E = 0.000000
F = 0.000000
https://ideone.com/pHXG11
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!