Проектирование и создание базы данных для автоматизированной информационной системы "Оплата услуг центра доступа в Интернет"

p>      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; 

function ToStr(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

  for i := 1 to Rows do // выводим содержимое матрицы

   for j := 1 to Cols do

    sg.Cells[j-1, i-1] := ToStr(arr[i, j]);

  except

  end;

end; 

procedure Matricy.SetValues(ADODataSet1: TADODataSet); // процедура установки в матрицах (X,Y) значений,

                                                       // берущихся из БД с помощью ADO-соединения

var

  i : integer;

begin

  ADODataSet1.First;

  X := Matrix.Create;

  Y := Matrix.Create;

  X.Cols := 5;

  Y.Cols := 1;

  X.Rows := ADODataSet1.RecordCount;

  Y.Rows := X.Rows;

  for i := 1 to X.Rows do begin

   // выделяем записи по одной

    X.arr[i, 1] := 1;

    X.arr[i, 2] := ADODataSet1.FieldValues['Kol_oborud'];

    X.arr[i, 3] := ADODataSet1.FieldValues['Kol_zap'];

    X.arr[i, 4] := ADODataSet1.FieldValues['Kol_otkaz'];

    X.arr[i, 5] := ADODataSet1.FieldValues['Stoimost_Ed'];

    Y.arr[i, 1] := ADODataSet1.FieldValues['Srok_SL'];

    ADODataSet1.Next;

  end;

end; 

procedure Main.Run;   // Метод "Выполнить" производит расчеты над исходными

                      // матрицами и выдает результаты на экран.

var

  a, b, S, R, b1, a1, c1 : Matrix;

  i, j, l, p,m,n : integer;

  sum, d1, d2, Qr, Qost, Fr : 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);   // получили матрицу коэффициентов  в уравнении регрессии

  // Выведем  само уравнение регрессии: Y=A1 + A2 * X1 + A3 * X2 + A4 * X3 + A5 * X4:

  st := 'Y = ' + ToStr(a.arr[1,1]) + ' + ' + ToStr(a.arr[2, 1]) + ' * X1 + ' +

  ToStr(a.arr[3, 1]) + ' * X2 + ' + ToStr(a.arr[4, 1]) + ' * X3 + ' +

  ToStr(a.arr[5, 1]) + ' * X4.';

  p := Pos(' + -', st); // находим, где в строчке подряд идет +-, лишний + убираем

  while p > 0 do begin  // (если коэффициент отрицателен, + перед ним не ставится)

    s1 := Copy(st, 1, p);

    Delete(st, 1, p + 3);

    st := s1 + '- ' + st;

    p := Pos(' + -', st);

  end;

  Analys1.Label12.Caption := st;

  //Analys1.Button1.Enabled := false;

  a1 := a.Submatrix(0, 0);

  b1 := X.Submatrix(0, 0);

  b1.Umn(a1);

  c1 := b1.Submatrix(0, 0); // расчет критерия Фишера

  b1.Transpon;

  b1.Umn(c1);

  Qr := b1.arr[1,1];

  a1 := a.Submatrix(0, 0);

  b1 := X.Submatrix(0, 0);

  c1 := Y.Submatrix(0, 0);

  b1.Umn(a1);

  c1.Minus(b1);

  a1 := c1.Submatrix(0, 0);

  c1.Transpon;

  c1.Umn(a1);

  Qost := c1.arr[1,1];

  Fr:=(Qr/m)/(Qost/(n-m-1));

  Analys1.Label5.Caption:=ToStr(Fr);

  if (StrToFloat(Analys1.Edit1.Text)<(strtofloat(Analys1.Label5.Caption)))

    then

    Analys1.Label14.Caption:='Коэффициенты значимы' else  Analys1.Label14.Caption:='Коэффициенты незначимы'

end; 

procedure ClearTable(sg : TStringGrid);

var

  i, j : integer;

begin

  for i := 1 to sg.RowCount do

   for j := 1 to sg.ColCount do

    sg.Cells[j-1, i-1] := '';

end; 

procedure TAnalys.FormShow(Sender: TObject); // Обновляем подключение к БД при показе формы

begin

  ADODataSet1.Active := false;

  ADODataSet1.Active := true;

  ClearTable(sgX);

  ClearTable(sgY);

//  ClearTable(Analys1.sgXTX);

//  ClearTable(Analys1.sgInv);

//  ClearTable(Analys1.sgXTY);

  ClearTable(Analys1.sgA);

  ClearTable(Analys1.sgK);

  sgK.Cells[1, 0] := 'Y';

  sgK.Cells[2, 0] := 'X1';

  sgK.Cells[3, 0] := 'X2';

  sgK.Cells[4, 0] := 'X3';

  sgK.Cells[5, 0] := 'X4';

  sgK.Cells[0, 1] := 'Y';

  sgK.Cells[0, 2] := 'X1';

  sgK.Cells[0, 3] := 'X2';

  sgK.Cells[0, 4] := 'X3';

  sgK.Cells[0, 5] := 'X4';

  Label8.Caption := '';

  Label9.Caption := '';

  Label10.Caption := '';

  Label11.Caption := '';

  Label12.Caption := ''; 

end; 

procedure TAnalys.Button1Click(Sender: TObject); // При нажатии на кнопку "Начать":

var

  m : Main;

begin

  m := Main.Create;

  m.SetValues(ADODataSet1); // задаем значения из БД

  m.Run;

end;

end.