Показать сообщение отдельно
  #6  
Старый 23.10.2011, 13:05
Аватар для DelphiM0ZG
DelphiM0ZG DelphiM0ZG вне форума
Новичок
 
Регистрация: 22.10.2011
Сообщения: 62
Репутация: 666
По умолчанию

Вот код этой функции, код может быть не совсем оптимизированный: он двухлетней давности, а я тогда не имел привычки структурировать код. Сейчас собираюсь написать большой модуль для работы с матрицами - хочу поместить туда все действия с матрицами, которые я знаю, но всё упирается во время, а у меня его пока нет.
Код:
Const
  N0=20;

Type
  Matrix=Array[0..N0-1, 0..N0-1] Of Extended;

Function MatrixOpred(F: Matrix; Const N: Byte):Extended;
Var
   B: Matrix;
   d, t, y, g, s: Extended;
   k, c, i, j, v, kn, l: Byte;
Begin  (* начало функции *)
  kn:=0;
  If (N=1) Then D:=F[0, 0] (* определитель матрицы, состоящей из одного элемента *)
  Else If (N=2) Then D:=F[0, 0]*F[1, 1]-F[0, 1]*F[1, 0] (* если матрица 2*2 *)
  Else
    Begin (* если размер матрицы больше, чем 2 *)
      For k:=0 To N-2 Do  (* основной цикл прямого хода *)
        Begin
          D:=F[k, k]; (* ведущий элемент t=d*y => y=t/d *)
          If (d=0) Then
            Begin (* является ли ведущий элемент нулевым *)
              l:=0;
              Repeat
                l:=l+1; (* нахождение первого ненулевого элемента в столбце *)
              Until ((F[k+l, k]<>0) Or (l>=N));
              If (l<N) Then
                Begin
                  For v:=k To N-1 Do (* цикл, меняющий строки местами *)
                    Begin
                      B[k, v]:=F[k, v];(* ведущая строка с нулевым элементом *)
                      F[k, v]:=F[k+l, v];(* эта строка теперь с ненулеывм элементом *)
                      F[k+l, v]:=B[k, v];(* та строка, которая была с нулём *)
                    End;
                  d:=F[k, k];(* новый ведущий элемент *)
                  kn:=kn+1;(* сколько раз менялись строки *)
                End
              Else
                Begin
                  MatrixOpred:=0;
                  Exit;
                End;
            End;

            For j:=k To N-1 Do B[k, j]:=F[k, j];(* сохранение исходной опорной строки в массив *)

            For c:=k+1 To N-1 Do (* цикл прокрутки столбца ведомых элементов *)
              Begin
                T:=F[c, k]; (* ведомый элемент *)
                If (t<>0) Then (* если ведомый элемент нулю ещё не равен, то: *)
                  Begin
                    If (d<>0) Then (* проверяю равен ли нулю ведущий элемент *)
                      y:=t/d;(* разделил ведомый элемент на ведущий, и получил: *)
                      (* число, на которое нужно умножить ведущую строку *)
                      For j:=k To N-1 Do
                        Begin
                          F[k, j]:=B[k, j];(* сохранение исходной ведущей строки *)
                          F[k, j]:=F[k, j]*y; (* умножение ведущей строки на число *)
                          F[c, j]:=F[c, j]-F[k, j];(* вычитание ведущей строки из ведомой *)
                        End;
                  End;
              End; (* сохранился ли ведущий элемент, если нет - возврат исходной строки *)

            If (g<>F[k, k]) Then
              For j:=k To N-1 Do F[k, j]:=B[k, j];
        End;
        (* матрица приведена к верхне-треугольному виду *)
      D:=1;(* вычисляем определитель *)
      j:=0;
      For i:=0 To N-1 Do
        Begin
          D:=D*F[i, j]; (* перемножаем элементы главной диагонали *)
          Inc(j);
        End;
      (* если строку меняли нечётное количество раз, то умножаем определитель на (-1) *)
      If (Odd(Kn)) Then D:=-D;
    End;
  MatrixOpred:=D;(* имя функции равно полученному результату *)
End;
Ответить с цитированием