Материал: Мансуров. Основы программирования в среде Lazarus. 2010

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

{private declarations } public

{public declarations } end;

//Процедура решения СЛАУ методом Гаусса

procedure gauss(vector: array of real; b: array of real;

var x: array of real; n: byte;

var solve: byte);

//n - размерность системы,

//solve=0, если решение единственное,

//solve=1, если система не имеет решения,

//solve=2, если система имеет бесконечное количество решений,

//Функция, подбираемая методом

//наименьших квадратов

function fx(t: real): real;

// Функция возведения в степень

function stepen( x: real; n: byte): real;

var

Form1: TForm1; n: byte;

x1, y1: real;

x, y, z: array of real; Fname: string;

implementation

726

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

function fx(t: real): real; begin

Result:= z[0] + z[1]*t + z[2]*t*t + z[3]*t*t*t + z[4]*sqr(sqr(t));

end;

function stepen( x: real; n: byte): real; var

i: integer; begin

Result:= 1;

for i:= 1 to n do Result:= Result*x;

end;

// Реализация метода Гаусса

procedure Gauss(vector: array of real; b: array of real; var x: array of real; n: byte;

var solve: byte);

var

a: array of array of real; { матрица коэффициентов системы,

двумерный динамический массив}

i, j, k, p, r: integer;

m, s, t: real;

begin

SetLength(a, n, n); // установка фактического размера массива

{ Преобразование одномерного массива в двумерный }

k:=0;

for i:=0 to n-1 do

727

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

for j:=0 to n-1 do begin

a[i, j]:= vector[k]; k:=k+1;

end;

for k:=0 to n-2 do begin

for i:=k+1 to n-1 do begin

if (a[k, k]=0) then begin

{ перестановка уравнений}

p:=k; // в алгоритме используется буква l, но она похожа на 1

// Поэтому используем идентификатор p for r:=i to n-1 do

begin

if abs(a[r, k]) > abs(a[p, k]) then p:=r; end;

if p<>k then begin

for j:= k to n-1 do begin

t:=a[k, j];

a[k, j]:=a[p, j]; a[p, j]:=t;

end;

t:=b[k];

b[k]:=b[p];

b[p]:=t;

728

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

end;

end; // конец блока перестановки уравнений m:=a[i,k]/a[k, k];

a[i, k]:=0;

for j:=k+1 to n-1 do begin

a[i, j]:=a[i, j]-m*a[k, j]; end;

b[i]:= b[i]-m*b[k]; end;

end;

{Проверка существования решения} if a[n-1,n-1] <> 0 then begin

x[n-1]:=b[n-1]/a[n-1,n-1]; for i:=n-2 downto 0 do begin

s:=0;

for j:=i+1 to n-1 do begin

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

x[i]:=(b[i] + s)/a[i, i]; end;

solve:= 0; end

else

if b[n-1] = 0 then begin

729

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

MessageDlg('Система имеет бесконечное ' +

'количество решений', mtInformation,[mbOK], 0); solve:= 2;

end else begin

MessageDlg('Система не имеет решений',

mtInformation,[mbOK], 0);

solve:= 1; end;

{ освобождение памяти,

распределенной для динамического массива }

a:=nil;

end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject); begin

Chart1.Title.Text.Text:='Метод наименьших квадратов'; MCalculate.Enabled:= false;

Menu_Exp.Enabled:= false;

Menu_Curve.Enabled:= false;

end;

procedure TForm1.Menu_ExpClick(Sender: TObject);

{Процедура вывода графика экспериментальных

данных по точкам}

var

730