Построение эмпирических формул методом наименьших квадратов (МНК) средствами пакета Microsoft Excel, страница 8

Блок-схема алгоритма метода наименьших квадратов

Блок схема метода Гаусса решение СЛАУ

Подпись: If  i=k  go toПодпись: k=n, mПодпись: j=k+1, n+1Подпись: A[k,j]=A[k,j]/A[k,k]Подпись: i=n, mПодпись: j=k+1, m+1Подпись: A[i,j]=A[i,j]-A[i,k]*A[k,j]

Программа.

Program Approximasiy;

uses crt;

  const

    n=25;

    m=2;

  Type

    Matxy=array [1..n] of real;

    Matr1=array [1..3,1..4] of real;

    Matr2=array [1..n,1..3] of real;

  Var i,j,k,c: integer;

      d,d1: text;

      X,Y: Matxy;

      R: Matr1;

      A: Matr2;

      g: real;

Procedure ReadXY(n: integer; var c: Matxy);

  Var i:integer;

  Begin

    For i:=1 to n do

      Read(d,c[i]);

  End;

Procedure Gauss (m: integer; var c: Matr1);

Begin

  For i:=1 to m do

    Begin

      For j:=i+1 to m+1 do

        c[i,j]:=c[i,j]/c[i,i];

      For k:=1 to m do

        If (k<>i) then

          For j:=i+1 to m+1 do

            c[k,j]:=c[k,j]-c[k,i]*c[i,j];

    End;

End;

Begin

  clrscr;

  Assign(d,'C:\Danil.dat');

  Reset(d);

  Assign(d1,'C:\Otvet.dat');

  Rewrite(d1);

  ReadXY(n,x);

  ReadXY(n,y);

  Close(d);

  For c:=1 to m do

    Begin

      For i:=1 to n do             {Формирование матрицы R}

        Begin

          a[i,1]:=1;

          For j:=2 to c+1 do

            a[i,j]:=a[i,j-1]*x[i];

        End;

        WriteLn(d1,'Матрица A');

        WriteLn('Матрица A');

      For i:=1 to c+1 do           {Формирование матрицы A}

        Begin

          For j:=1 to c+1 do

            Begin

              g:=0;

              For k:=1 to n do     {Матрица коэффициентов}

                g:=g+a[k,i]*a[k,j];

              r[i,j]:=g;