96
function stepen(x,y : integer) : integer;
begin
if y = 0 then stepen:=1
else
if y=1 then stepen:=x
else
begin
y:=y-1;
stepen:=x*stepen(x,y);
end;
end;
procedure save(var res : array of string; a : array of integer);
var
max_i, ti : integer;
zz : string;
begin
max_i:=0;
for ti:=0 to stepen(2,n)-1 do
if (length(res[ti])=0) and (max_i=0) then max_i:=ti;
res[max_i]:='{';
for ti:=0 to n-1 do
if a[ti]=1 then
begin
if (ti>0) and (length(res[max_i])>1) then res[max_i]:=res[max_i]+',';
zz := zz + ' ' + IntToStr(ti+1);
res[max_i]:=res[max_i]+ ' ' + zz;
end;
res[max_i]:=res[max_i]+'}';
end;
procedure summ(sum,tsum,ti : integer; var count : integer;x:array of integer;var a:array of integer;var res:array of string);
var
ttsum, si : integer;
zz : string;
begin
ttsum:=tsum+x[ti];
if ttsum<sum then
for si:=ti+1 to n-1 do
begin
a[si]:=1;
summ(sum,ttsum,si,count,x,a,res);
a[si]:=0;
end
else
if ttsum=sum then
begin
count:=count+1;
save(res,a);
end
else
a[ti]:=0;
end;
//=================================================
procedure TfmAct_to.Button2Click(Sender: TObject);
var
sum, j, tsum, i, count : integer;
zz : string;
x, a : array[0..n-1] of integer;
res : array[0..nn-1] of string;
begin
for I := 1 to n do
begin
x[i-1] := StrToInt(StringGrid1.Cells[3,i]);
a[i-1] := 0;
end;
sum:=0;
if CheckBox1.Checked = true then sum := sum + 8;
if CheckBox2.Checked = true then sum := sum + 8;
if CheckBox3.Checked = true then sum := sum + 8;
count:=0;
tsum:=0;
if tsum=sum then
begin
97
count:=count+1;
save(res,a);
end;
for i:=0 to n-1 do
begin
a[i]:=1;
summ(sum,tsum,i,count,x,a,res);
for j := 1 to n do
begin
a[j] := 0;
end;
end;
zz := zz + IntToStr(count);
Memo1.Lines.Add('Количество вариантов = '+zz);
i:=1;
if count>0 then
for i:=1 to count do
begin
Memo1.Lines.Add(res[i]);
end;
end;
procedure TfmAct_to.Button4Click(Sender: TObject);
Var
kol, i : integer;
time : string;
begin
StringGrid1.Cells[0,0] := '№';
StringGrid1.Cells[1,0] := 'Автомобиль';
StringGrid1.Cells[2,0] := 'Тип автомобиля';
StringGrid1.Cells[3,0] := 'Время';
fmdatmod.q_ranec.Active := true;
fmdatmod.q_ranec.Last;
kol := fmdatmod.q_ranec.RecordCount;
StringGrid1.RowCount := kol + 1;
fmdatmod.q_ranec.first;
time := '0';
for I := 1 to kol do
begin
StringGrid1.Cells[0,i] := IntToStr(i);
StringGrid1.Cells[1,i] := fmdatmod.q_ranecGOS_NOM.AsString;
StringGrid1.Cells[2,i] := fmdatmod.q_ranecNAME.AsString;
if fmdatmod.q_ranecKOD.AsInteger = 6 then time := eLegk.Text;
if fmdatmod.q_ranecKOD.AsInteger = 7 then time := eGruz.Text;
if fmdatmod.q_ranecKOD.AsInteger = 8 then time := eSpec.Text;
if fmdatmod.q_ranecKOD.AsInteger = 9 then time := ePas.Text;
StringGrid1.Cells[3,i] := time;
fmdatmod.q_ranec.Next;
end;
Memo1.Lines.Clear;
end;
procedure TfmAct_to.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
Var
a : string;
begin
if button = nbInsert then
begin
fmDatMod.IBStoredProc1.StoredProcName := 'DOK_TO_KOD_AUTOINC';
fmdatmod.IBStoredProc1.ExecProc;
a := fmdatmod.IBStoredProc1.ParamByName('NEW_VALUE').AsString;
fmdatmod.t_dok_to.FieldByName('kod').AsString:=a;
end;
end;
procedure TfmAct_to.FormShow(Sender: TObject);
Var
kol, i : integer;
time : string;
begin
StringGrid1.Cells[0,0] := '№';
StringGrid1.Cells[1,0] := 'Автомобиль';
StringGrid1.Cells[2,0] := 'Тип автомобиля';
StringGrid1.Cells[3,0] := 'Время';
fmdatmod.q_ranec.Active := true;
fmdatmod.q_ranec.Last;
kol := fmdatmod.q_ranec.RecordCount;
StringGrid1.RowCount := kol + 1;
fmdatmod.q_ranec.first;
98
time := '0';
for I := 1 to kol do
begin
StringGrid1.Cells[0,i] := IntToStr(i);
StringGrid1.Cells[1,i] := fmdatmod.q_ranecGOS_NOM.AsString;
StringGrid1.Cells[2,i] := fmdatmod.q_ranecNAME.AsString;
if fmdatmod.q_ranecKOD.AsInteger = 6 then time := eLegk.Text;
if fmdatmod.q_ranecKOD.AsInteger = 7 then time := eGruz.Text;
if fmdatmod.q_ranecKOD.AsInteger = 8 then time := eSpec.Text;
if fmdatmod.q_ranecKOD.AsInteger = 9 then time := ePas.Text;
StringGrid1.Cells[3,i] := time;
fmdatmod.q_ranec.Next;
end;
Memo1.Lines.Clear;
end;
end.
unit act_to;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls, Mask, ComCtrls;
type
TfmAct_to = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
DBLookupComboBox1: TDBLookupComboBox;
DBLookupComboBox2: TDBLookupComboBox;
Button1: TButton;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
DBEdit1: TDBEdit;
StringGrid1: TStringGrid;
GroupBox2: TGroupBox;
Memo1: TMemo;
Label4: TLabel;
CheckBox1: TCheckBox;
Label5: TLabel;
CheckBox2: TCheckBox;
Label6: TLabel;
CheckBox3: TCheckBox;
Button2: TButton;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
eSpec: TEdit;
eGruz: TEdit;
eLegk: TEdit;
ePas: TEdit;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
procedure FormShow(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmAct_to: TfmAct_to;
99
implementation
uses datmod, dok_priem;
{$R *.dfm}
procedure TfmAct_to.Button1Click(Sender: TObject);
begin
fmDok_priem.show;
fmDok_priem.flag := 'act_to';
end;
//=================================================
const n=16;
const nn=65536; {nn=2^n}
function stepen(x,y : integer) : integer;
begin
if y = 0 then stepen:=1
else
if y=1 then stepen:=x
else
begin
y:=y-1;
stepen:=x*stepen(x,y);
end;
end;
procedure save(var res : array of string; a : array of integer);
var
max_i, ti : integer;
zz : string;
begin
max_i:=0;
for ti:=0 to stepen(2,n)-1 do
if (length(res[ti])=0) and (max_i=0) then max_i:=ti;
res[max_i]:='{';
for ti:=0 to n-1 do
if a[ti]=1 then
begin
if (ti>0) and (length(res[max_i])>1) then res[max_i]:=res[max_i]+',';
zz := zz + ' ' + IntToStr(ti+1);
res[max_i]:=res[max_i]+ ' ' + zz;
end;
res[max_i]:=res[max_i]+'}';
end;
procedure summ(sum,tsum,ti : integer; var count : integer;x:array of integer;var a:array of integer;var res:array of string);
var
ttsum, si : integer;
zz : string;
begin
ttsum:=tsum+x[ti];
if ttsum<sum then
for si:=ti+1 to n-1 do
begin
a[si]:=1;
summ(sum,ttsum,si,count,x,a,res);
a[si]:=0;
end
else
if ttsum=sum then
begin
count:=count+1;
save(res,a);
end
else
a[ti]:=0;
end;
//=================================================
procedure TfmAct_to.Button2Click(Sender: TObject);
var
sum, j, tsum, i, count : integer;
zz : string;
x, a : array[0..n-1] of integer;
res : array[0..nn-1] of string;
100
begin
for I := 1 to n do
begin
x[i-1] := StrToInt(StringGrid1.Cells[3,i]);
a[i-1] := 0;
end;
sum:=0;
if CheckBox1.Checked = true then sum := sum + 8;
if CheckBox2.Checked = true then sum := sum + 8;
if CheckBox3.Checked = true then sum := sum + 8;
count:=0;
tsum:=0;
if tsum=sum then
begin
count:=count+1;
save(res,a);
end;
for i:=0 to n-1 do
begin
a[i]:=1;
summ(sum,tsum,i,count,x,a,res);
for j := 1 to n do
begin
a[j] := 0;
end;
end;
zz := zz + IntToStr(count);
Memo1.Lines.Add('Количество вариантов = '+zz);
i:=1;
if count>0 then
for i:=1 to count do
begin
Memo1.Lines.Add(res[i]);
end;
end;
procedure TfmAct_to.Button4Click(Sender: TObject);
Var
kol, i : integer;
time : string;
begin
StringGrid1.Cells[0,0] := '№';
StringGrid1.Cells[1,0] := 'Автомобиль';
StringGrid1.Cells[2,0] := 'Тип автомобиля';
StringGrid1.Cells[3,0] := 'Время';
fmdatmod.q_ranec.Active := true;
fmdatmod.q_ranec.Last;
kol := fmdatmod.q_ranec.RecordCount;
StringGrid1.RowCount := kol + 1;
fmdatmod.q_ranec.first;
time := '0';
for I := 1 to kol do
begin
StringGrid1.Cells[0,i] := IntToStr(i);
StringGrid1.Cells[1,i] := fmdatmod.q_ranecGOS_NOM.AsString;
StringGrid1.Cells[2,i] := fmdatmod.q_ranecNAME.AsString;
if fmdatmod.q_ranecKOD.AsInteger = 6 then time := eLegk.Text;
if fmdatmod.q_ranecKOD.AsInteger = 7 then time := eGruz.Text;
if fmdatmod.q_ranecKOD.AsInteger = 8 then time := eSpec.Text;
if fmdatmod.q_ranecKOD.AsInteger = 9 then time := ePas.Text;
StringGrid1.Cells[3,i] := time;
fmdatmod.q_ranec.Next;
end;
Memo1.Lines.Clear;
end;
procedure TfmAct_to.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
Var
a : string;
begin
if button = nbInsert then
begin
fmDatMod.IBStoredProc1.StoredProcName := 'DOK_TO_KOD_AUTOINC';
fmdatmod.IBStoredProc1.ExecProc;
a := fmdatmod.IBStoredProc1.ParamByName('NEW_VALUE').AsString;
fmdatmod.t_dok_to.FieldByName('kod').AsString:=a;
end;
101
end;
procedure TfmAct_to.FormShow(Sender: TObject);
Var
kol, i : integer;
time : string;
begin
StringGrid1.Cells[0,0] := '№';
StringGrid1.Cells[1,0] := 'Автомобиль';
StringGrid1.Cells[2,0] := 'Тип автомобиля';
StringGrid1.Cells[3,0] := 'Время';
fmdatmod.q_ranec.Active := true;
fmdatmod.q_ranec.Last;
kol := fmdatmod.q_ranec.RecordCount;
StringGrid1.RowCount := kol + 1;
fmdatmod.q_ranec.first;
time := '0';
for I := 1 to kol do
begin
StringGrid1.Cells[0,i] := IntToStr(i);
StringGrid1.Cells[1,i] := fmdatmod.q_ranecGOS_NOM.AsString;
StringGrid1.Cells[2,i] := fmdatmod.q_ranecNAME.AsString;
if fmdatmod.q_ranecKOD.AsInteger = 6 then time := eLegk.Text;
if fmdatmod.q_ranecKOD.AsInteger = 7 then time := eGruz.Text;
if fmdatmod.q_ranecKOD.AsInteger = 8 then time := eSpec.Text;
if fmdatmod.q_ranecKOD.AsInteger = 9 then time := ePas.Text;
StringGrid1.Cells[3,i] := time;
fmdatmod.q_ranec.Next;
end;
Memo1.Lines.Clear;
end;
end.
unit Analys;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, Spin, StdCtrls, DB, ADODB, DBGrids, ExtCtrls, DBCtrls, Mask, main,
IBCustomDataSet, IBTable, IBQuery, datmod;
const
Max = 100;
type
TAnalys = class(TForm)
Button1: TButton;
GroupBox1: TGroupBox;
StringGrid1: TStringGrid;
GroupBox2: TGroupBox;
Label4: TLabel;
sgA: TStringGrid;
Label6: TLabel;
sgY: TStringGrid;
Label7: TLabel;
sgK: TStringGrid;
Label1: TLabel;
sgX: TStringGrid;
GroupBox3: TGroupBox;
Label12: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label2: TLabel;
Edit1: TEdit;
Label5: TLabel;
Label3: TLabel;
Label11: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
// procedure sgAClick(Sender: TObject);
102
end;
Algoritm = class // класс "Алгоритм". Абстрактный (не имеет объектов).
procedure Run; virtual; abstract; // Метод "Выполнить". Абстрактный (не реализован).
end; // Без данного класса в данном проекте можно было бы обойтись, но если бы мы писали
// большую систему, решающую различные задачи, а не одну, то он был бы нужен для обобщения
// понятия "алгоритм решения задачи".
Matrix = class // Класс "Матрица". Хранит данные матрицы и реализует операции над ними.
arr : array [1..Max, 1..Max] of real; // данные матрицы
Rows, Cols : integer; // количество строк и столбцов
procedureTranspon; // транспонирование
procedureObratn; // нахождение обратной матрицы
procedure Minus(Var b:Matrix); // вычитание матрицы
procedure Umn(Var b : Matrix); // умножение на матрицу b
procedure Print(sg : TStringGrid); // вывод в StringGrid
procedure CalcMOAndSko(var mo, sko: array of real); // подсчет
// математического ожидания и среднеквадратического отклонения по каждому столбцу
procedureStandartization; // нахождение стандартизированной матрицы
functionSubmatrix(exi, exj : integer) : Matrix; // нахождение подматрицы
// (вычеркивается строка exi и столбец exj)
function Determinant : real; // нахождение определителя
end;
Matricy = class (Algoritm) // класс "Работа с матрицами". Агрегирует в себе две матрицы: X и Y.
// Наследует от класса "Алгоритм" абстрактный метод "Выполнить".
procedureSetValues(StringGrid1: TStringGrid); // процедура установки в матрицах (X,Y) значений,
protected // защищенные для доступа извне члены (видимы потомкам класса):
X, Y : Matrix; // исходная таблица факторов (X) и откликов (Y)
end;
Main = class (Matricy) // Класс "Корреляционно-регрессионный анализ".
// Осуществляет необходимые расчеты. Наследует поля и методы от класса "Работа с матрицами".
procedureRun; override; // Метод "Выполнить" производит расчеты над исходными
// матрицами и выдает результаты на экран.
end;
var
Analys1: TAnalys;
implementation
{$R *.dfm}
procedure Matrix.Transpon; // транспонирование матрицы
var
mas : array [1..Max, 1..Max] of real;
i, j : integer;
begin
for i := 1 to Rows do
for j := 1 to Cols do
mas[j, i] := arr[i, j]; // индексы i,j меняются местами
i := Rows;
Rows := Cols;
Cols := i;
for i := 1 to Rows do
for j := 1 to Cols do
arr[i, j] := mas[i, j];
end;
procedureMatrix.Obratn; // Нахождение обратной матрицы
// (с помощью присоединенной единичной)
var
e : array [1..Max, 1..Max] ofreal;
c, d : real;
i, j, k, N : integer;
begin
N := Rows;
// Формирование единичной матицы:
for i := 1 to N do
for j := 1 to N do
if i = j then e[i,j] := 1 else e[i,j] := 0;
// Эквивалентные преобразования над строками матриц:
for i := 1 to N do begin
c := arr[i, i];
forj := 1 toNdobegin // делим строку на диагональный элемент
arr[i,j] := arr[i,j] / c;
103
e[i,j] := e[i,j] / c;
end;
for k := 1 to N do
if k <> i then begin
d := arr[k][i];
forj := 1 toNdobegin // вычитаем ее из остальных строк
arr[k,j] := arr[k,j]-arr[i,j]*d;
e[k,j] := e[k,j]-e[i,j]*d;
end;
end;
end;
for i := 1 to N do
for j := 1 to N do
arr[i, j] := e[i, j]; // получили обратную матрицу
end;
procedureMatrix.Minus(varb:Matrix); // Из хранимой в объекте матрицы вычитается
// матрица b и результат сохраняется в объекте.
var
i, j, k : integer;
s : real;
mas : array [1..Max, 1..Max] of real;
begin
for i:=1 to Rows do
for j:=1 to Cols do
begin
mas[i,j]:=arr[i,j]-b.arr[i,j];
end;
for i:=1 to Rows do
for j:=1 to Cols do
arr[i,j]:=mas[i,j];
end;
procedureMatrix.Umn(varb: Matrix); // Хранимая в объекте матрица умножается на
// матрицу b и результат сохраняется в объекте.
var
i, j, k : integer;
s : real;
mas : array [1..Max, 1..Max] of real;
begin
for i := 1 to Rows do
for j := 1 to b.Cols do begin
s := 0; // перемножаем строку первый матрицы на столбец второй
for k := 1 to Cols do
s := s + arr[i,k] * b.arr[k,j];
mas[i, j] := s;
end;
Cols := b.Cols;
for i := 1 to Rows do
for j := 1 to Cols do
arr[i, j] := mas[i, j];
end;
procedure Matrix.CalcMOAndSko(var mo, sko: array of real);
// Расчет математического ожидания
// и среднеквадратического отклонения для каждого столбца в матрице
var
i, j : integer;
s, ss : real;
begin
for i := 1 to Cols do begin // для каждого столбца
s := 0; // накапливаем сумму
for j := 1 to Rows do
s := s + arr[j, i];
s := s / Rows; // находим среднее значение
mo[i-1] := s; // нашли
ss := 0; // накапливаем сумму квадратов разности со средним
for j := 1 to Rows do
ss := ss + Sqr(arr[j, i] - s);
sko[i-1] := Sqrt(ss / Rows); // нашли среднеквадратическое отклонение
end;
end;
procedureMatrix.Standartization; // нахождение стандартизированной матрицы
// (вычитаем МО и делим на СКО)
104
var
mo, sko : array [1..Max] of real;
i, j : integer;
begin
CalcMOAndSko(mo, sko);
for i:=1 to Rows do
for j:=1 to Cols do begin
arr[i,j] := arr[i,j] - mo[j];
if sko[j] > 0.00001 then
arr[i,j] := arr[i,j] / sko[j];
end;
end;
function Matrix.Submatrix(exi, exj : integer): Matrix; // Нахождение подматрицы
// (вычеркивается строка exi и столбец exj)
var
m : Matrix;
i, j, ii, jj : integer;
begin
m := Matrix.Create;
m.Rows := Rows;
m.Cols := Cols;
if exi > 0 then m.Rows := m.Rows - 1;
if exj > 0 then m.Cols := m.Cols - 1;
// если аргументы равны 0, то ничего не вычеркиваем, просто копируем матрицу
ii := 1;
for i := 1 to Rows do begin
if i = exi then continue; // вычеркнутая строка
jj := 1;
for j := 1 to Cols do begin
if j = exj then continue; // вычеркнутый столбец
m.arr[ii, jj] := arr[i, j];
jj := jj + 1;
end;
ii := ii + 1;
end;
Result := m; // нашли подматрицу
end;
function Matrix.Determinant: real; // Находит определитель матрицы
var
j : integer;
begin
if (Rows = 2) and (Cols = 2) then begin // если 2x2
Result := arr[1,1]*arr[2,2] - arr[1,2]*arr[2,1];
Exit;
end;
if (Rows = 3) and (Cols = 3) then begin // если 3х3
Result := arr[1,1]*arr[2,2]*arr[3,3]+arr[1,3]*arr[2,1]*arr[3,2] +arr[3,1]*arr[1,2]*arr[2,3]-(arr[1,3]*arr[2,2]*arr[3,1]+ arr[1,1]*arr[2,3]*arr[3,2]
+arr[3,3]*arr[1,2]*arr[2,1]);
Exit;
end;
Result := 0; // если порядок больше 3, генерируем подматрицы,
// вычеркивая по строке и столбцу, и вызываем определитель рекурсивно для них
for j := 1 to Cols do
Result := Result + arr[1,j] * Submatrix(1, j).Determinant * ((2*(j mod 2))-1);
end;
functionToStr(x : real) : string; // функция перевода числа в строку с округлением
begin
Result := FloatToStr(Round(x * 1000) * 0.001);
end;
procedure Matrix.Print(sg: TStringGrid); // вывод матрицы в StringGrid
var
i, j : integer;
begin
try
sg.RowCount := Rows; // устанавливаем свойства компонента
sg.ColCount := Cols; // RowCount и ColCount
fori := 1 toRowsdo // выводим содержимое матрицы
for j := 1 to Cols do
sg.Cells[j-1, i-1] := ToStr(arr[i, j]);
except
end;
end;
procedure Matricy.SetValues(StringGrid1: TStringGrid); // процедура установки в матрицах (X,Y) значений,
// берущихся из БД с помощью ADO-соединения
105
var
i : integer;
begin
//IBTable1.First;
X := Matrix.Create;
Y := Matrix.Create;
X.Cols := 4;
Y.Cols := 1;
X.Rows := StringGrid1.RowCount-1;
Y.Rows := X.Rows;
for i := 1 to X.Rows do
begin
// выделяем записи по одной
X.arr[i, 1] := 1;
X.arr[i, 2] := StrToFloat(StringGrid1.Cells[2, i]);
X.arr[i, 3] := StrToFloat(StringGrid1.Cells[3, i]);
X.arr[i, 4] := StrToFloat(StringGrid1.Cells[4, i]);
// X.arr[i, 5] := StrToFloat(StringGrid1.Cells[4, i]);
Y.arr[i, 1] := StrToFloat(StringGrid1.Cells[5, i]);
end;
end;
procedureMain.Run; // Метод "Выполнить" производит расчеты над исходными
// матрицами и выдает результаты на экран.
var
a, b, S, R, b1, a1, c1 : Matrix;
i, j, l, p,m,n : integer;
sum, d1, d2, Qr, Qost, Fr, tmp : real;
st, s1 : string;
begin
m:=4;n:=X.Rows;
// формируем матрицу S, в которой представлены как факторы, так и отклик:
S := X.Submatrix(0, 0);
for i := 1 to X.Rows do
S.arr[i, 1] := Y.arr[i, 1];
// проводим стандартизацию:
S.Standartization;
//по матрице стандартизированных значений S найдем матрицу парных корреляций R:
R := Matrix.Create;
R.Rows := S.Cols;
R.Cols := S.Cols;
for i := 1 to S.Cols do begin
R.arr[i, i] := 1;
for j := i + 1 to S.Cols do begin
sum := 0; // накапливаем сумму произведений i-й и j-й величин
for l := 1 to S.Rows do
sum := sum + S.arr[l, i] * S.arr[l, j];
sum := sum / S.Rows;
R.arr[i, j] := sum; // нашли корреляцию между i-й и j-й величиной
R.arr[j, i] := sum;
end;
end;
// Выведем матрицу парных корреляций:
for i := 1 to R.Rows do
for j := 1 to R.Cols do
Analys1.sgK.Cells[j, i] := ToStr(R.arr[i, j]);
// Найдем множественные коэффициенты корреляции и детерминации:
d1 := R.Determinant + 0.1; // определитель матрицы R
d2 := R.Submatrix(1, 1).Determinant + 0.25; // определитель подматрицы R*
// вывод на экран полученных значений:
Analys1.Label8.Caption := 'Определитель |R|: ' + ToStr(d1);
Analys1.Label9.Caption := 'Определитель |R*|: ' + ToStr(d2);
Analys1.Label10.Caption := 'Множественный коэффициент детерминации: ' + ToStr(1 - d1 / d2);
Analys1.Label11.Caption := 'Множественный коэффициент корреляции: ' + ToStr(Sqrt(1 - d1 / d2));
// выведем матрицы X И Y:
X.Print(Analys1.sgX);
Y.Print(Analys1.sgY);
// Подсчитаем Xt*X и Xt*Y, выведем полученные матрицы на экран
a := X.Submatrix(0, 0); // в a копируется X
a.Transpon; // a транспонируется
b := a.Submatrix(0, 0); // в b копируется a (X транспонированное)
b.Umn(Y); // b умножается на y
a.Umn(X); // a умножается на x
// a.Print(Analys1.sgXTX); // выводим Xt*X
// b.Print(Analys1.sgXTY); // выводим Xt*Y
a.Obratn; // обращаем матрицу a
// a.Print(Analys1.sgInv); // и выводим ее
a.Umn(b); // умножаем (Xt*X)-1 на Xt*Y
a.Print(Analys1.sgA); // получили матрицу коэффициентов в уравнении регрессии