Нахождение определителя методом Гаусса

@Meigas · Регистрация: 10.03.2012

Author24 — интернет-сервис помощи студентам

Нужно написать макрос который сможет найти определитель матрицы (n*n) используя метод Гаусса (вводится матрица с листа экселя).
Вот процедура решения СЛАУ методом Гаусса, но как с её помощью найти определитель - не могу понять, буду благодарен за помощь.

Visual Basic

Sub TrSolve()   ' Решение СЛАУ с верхней треугольной матрицей  (метод Гаусса)
Dim TR As Range
Dim N As Integer
For Each TR In Selection.Areas
  NM = TR.Count
  i1 = TR.Row: j1 = TR.Column
  ' N = (-1 + Sqr(1 + 4 * NM)) / 2   ' Способ первый
  N = 0: mn = 0                                 ' Способ  второй:
  Do While mn < NM:    N = N + 1: mn = N * (N + 1):   Loop
  ' Cells(i1, j1 + N + 1) = 999
  Dim b() As Double
  ReDim b(N)
   For i = 1 To N:  b(i) = TR.Cells(i, N + 1): Next
   For k = N To 1 Step -1
       Cells(i1 + N, j1 + k - 1) = b(k) / TR.Cells(k, k)
       S = 0
       For i = 1 To N - 1
          b(i) = b(i) - TR.Cells(i, k) * Cells(i1 + N, j1 + k - 1)
       Next i
  Next k
Exit For
Next
End Sub
 
Sub E()     '  Ctrl+Shift+E  - создать единичную матрицу
Dim TR As Range
Dim N As Integer
For Each TR In Selection.Areas
  N = Sqr(TR.Count)
   i1 = TR.Row: j1 = TR.Column
  TR = 0
  For i = 1 To N: Cells(i1 + i - 1, j1 + i - 1) = 1: Next
Next
End Sub
 
Sub Lk()  ' Нормирование ведущего столбца  (без наддиагонали) по шагам:
' Скопировать в E  ведущий столбец  (без наддиагонали) и  запустить по Ctrl+Shift+L макрос!
Dim TR As Range
Dim N As Integer
For Each TR In Selection.Areas
  N = TR.Count
  i1 = TR.Row: j1 = TR.Column
  For i = i1 + 1 To i1 + N - 1
      Cells(i, j1) = -Cells(i, j1) / Cells(i1, j1)
  Next i
   Cells(i1, j1) = 1
Next
End Sub

@ikki · 29.05.2012, 16:37

честно говоря, тоже не знал о таком методе.
узнал здесь

@Meigas · 29.05.2012, 16:54 **[ТС]**

ну вот в том и проблема, что не знаю как привести матрицу к ступенчатому виду (Верхнетреугольная матрица)

@ikki · 29.05.2012, 17:05

Сообщение от Meigas

не знаю как привести матрицу к ступенчатому виду

можно было бы ответить вежливо: "с помощью метода Гаусса" (типо - тупой ответ на тупой вопрос),
можно было бы дать ссылку на страничку в той же википедию, с описанием алгоритма метода Гаусса и пошаговым примером (предположив, что Вам религия не позволяет искать информацию на форуме и в сети),
можно было бы дать советы по циклам и операторам (когда Вы сделаете хоть какой-то, пусть и неправильный вариант)...

...но Вам ведь не это надо?

ок. тогда ждите.

@Meigas · 08.06.2012, 13:15 **[ТС]**

Написал код для нахождения определителя методом Гаусса - всё правильно считает, выводит в дебаг принт результат, но одна проблема - код не выдаёт отрицательный определитель, например для матрицы
2 1 1
4 3 0
-2 2 3
Определитель должен быть определитель 20 (это код делает правильно)
А для матрицы
4 3 0
2 1 1
-2 2 3
Код должен выдавать определитель -20, а выдаёт снова 20.

По методу Гаусса в формуле нужно возвести (-1) в степень p и умножить это на элементы главной диагонали(где p - это число перестановок строк)
Проблема в том, что не могу понять, как задать это число перестановок строк.
Вот сам код:

Visual Basic

Sub KGAUSS(ByRef Ab(), ByVal N, ByRef X(), IAI)
Dim j As Long 'переменная для реализации неявного цикла "Ab(i,k+1:N+1)"
Dim mx As Double, L As Long
IAI = 1
For k = 0 To N ' Перебор строк - шаги прямого хода
 mx = 0
 L = 0
   For i = k To N
      If Abs(Ab(i, k)) > mx Then L = i: mx = Ab(i, k)
   Next i
      For j = 0 To N + 1
         W = Ab(k, j): Ab(k, j) = Ab(L, j): Ab(L, j) = W
      Next j
      If Ab(k, k) = 0 Then IAI = 0 ' IAI - признак вырожденности системы
      If IAI = 0 Then Exit For ' Выход, если гл. элемент = 0
          For i = k + 1 To N ' Перебор строк с k+1-ой по N-ую
            Ab(i, k) = Ab(i, k) / Ab(k, k)
               For j = k + 1 To N + 1
                 Ab(i, j) = Ab(i, j) - Ab(i, k) * Ab(k, j)
               Next j
          Next i
Next k
For k = N To 0 Step -1 ' Обратная подстановка (обратный ход)
    X(k) = Ab(k, N + 1) / Ab(k, k)
    For j = 0 To N - 1
        Ab(j, N + 1) = Ab(j, N + 1) - Ab(j, k) * X(k)
    Next j
Next k
End Sub
 
Sub main()
Dim A(2, 3), X(2)
Call FromRangeToMatr(A, 2, 3)
Call KGAUSS(A(), 2, X(), IAI)
Call FromMasToColumn(1, 6, X, 2)
Debug.Print "Определитель:="; Det(A, 2)
End Sub
 
Function Det(A(), N)
Det = 1
For k = 0 To N
Det = Det * (-1) ^ p * A(k, k)
Next k
End Function
 
Sub FromRangeToMatr(ByRef A(), ByVal M, ByVal N)
' Ввод матрицы A(M,N) из диапазона ячеек рабочего листа Excel
Dim R As Range
Set R = Application.InputBox(prompt:="Укажите матрицу", Type:=8)
For i = 0 To M
  If i >= R.Rows.Count Then Exit For
  For j = 0 To N
    If j >= R.Columns.Count Then Exit For
    A(i, j) = R(i + 1, j + 1)
  Next j
Next i
End Sub
 
Sub FromMasToColumn(ByVal Row, ByVal Column, ByRef A(), ByVal N)
' Вывод массива A(N) в диапазон ячеек  $Row$Column:$(Row+N)$Column столбца
Ir = Row
For i = 0 To N
    Cells(Ir, Column) = A(i)
    Ir = Ir + 1
Next i
End Sub

Буду благодарен помощи.

@ikki · 08.06.2012, 14:11

Сообщение от Meigas

Проблема в том, что не могу понять, как задать это число перестановок строк.

его не надо "задавать".
его надо подсчитать.
p - это количество перестановок строк, выполненных в ходе работы алгоритма.
перестановки в вашем коде выполняются в строках 11-13.

@Meigas · 08.06.2012, 14:39 **[ТС]**

Сообщение от ikki_cf

его не надо "задавать".
его надо подсчитать.
p - это количество перестановок строк, выполненных в ходе работы алгоритма.
перестановки в вашем коде выполняются в строках 11-13.

Я понимаю, что там происходят перестановки, но все попытки сделать там подсчёт количества перестановок - оказались тщетны.

@ikki · 08.06.2012, 14:45

Сообщение от Meigas

но все попытки сделать там подсчёт

мда?..
я ни одной попытки не вижу.

@Meigas · 08.06.2012, 14:53 **[ТС]**

например

Visual Basic

        p = 0
         W = Ab(k, j): Ab(k, j) = Ab(L, j): Ab(L, j) = W
        p = kol + 1
              Next j

@ikki · 08.06.2012, 15:01

я не разобрал в деталях Ваш код, увидел только, что там многолишнего.
к примеру, зачем Вам строки с 23 по 28? они нужны только для решения СЛАУ, для определителя - не нужны.
но, в принципе, пусть остаются - пользы от них никакой, но и вреда немного

по вопросу:
попробуйте так:
1) объявите переменную уровня модуля (перед всеми процедурами)

Visual Basic

1	dim p as integer

2) перед строкой №11 кода из первого поста добавьте

Visual Basic

p = p + 1

вроде бы всё.
проверяйте.

@Meigas · 08.06.2012, 15:12 **[ТС]**

Проблема сохранилась, как выдавал определитель с плюсом - так и выдаёт, даже когда должен быть отрицальным

Visual Basic

Sub KGAUSS(ByRef Ab(), ByVal N, ByRef X(), IAI)
Dim j As Long 'переменная для реализации неявного цикла "Ab(i,k+1:N+1)"
Dim mx As Double, L As Long
Dim p As Integer
IAI = 1
For k = 0 To N ' Перебор строк - шаги прямого хода
 mx = 0
 L = 0
   For i = k To N
      If Abs(Ab(i, k)) > mx Then L = i: mx = Ab(i, k)
   Next i
   p = p + 1
          For j = 0 To N + 1
         W = Ab(k, j): Ab(k, j) = Ab(L, j): Ab(L, j) = W
                       Next j
      If Ab(k, k) = 0 Then IAI = 0 ' IAI - признак вырожденности системы
      If IAI = 0 Then Exit For ' Выход, если гл. элемент = 0
          For i = k + 1 To N ' Перебор строк с k+1-ой по N-ую
            Ab(i, k) = Ab(i, k) / Ab(k, k)
               For j = k + 1 To N + 1
                 Ab(i, j) = Ab(i, j) - Ab(i, k) * Ab(k, j)
               Next j
          Next i
Next k
For k = N To 0 Step -1 ' Обратная подстановка (обратный ход)
    X(k) = Ab(k, N + 1) / Ab(k, k)
    For j = 0 To N - 1
        Ab(j, N + 1) = Ab(j, N + 1) - Ab(j, k) * X(k)
    Next j
Next k
End Sub
Sub main()
Dim A(2, 3), X(2)
Call FromRangeToMatr(A, 2, 3)
Call KGAUSS(A(), 2, X(), IAI)
Call FromMasToColumn(1, 6, X, 2)
Debug.Print "Определитель:="; Det(A, 2)
End Sub
Function Det(A(), N)
Det = 1
For k = 0 To N
Det = Det * (-1) ^ p * A(k, k)
Next k
End Function

@ikki · 08.06.2012, 15:17

Сообщение от ikki_cf

1) объявите переменную уровня модуля (перед всеми процедурами)

как еще объяснить?

@Meigas · 08.06.2012, 15:20 **[ТС]**

Сообщение от ikki_cf

как еще объяснить?

Дико извиняюсь за невнимательность, вам огромное спасибо.

@~~Апострофф~~ · 08.06.2012, 21:52

Сообщение от аналитика

Visual Basic

Function det(matrix)
   Dim n As Byte, j As Byte
   Dim i_ As Byte, j_ As Byte
   Dim minor()
 
   n = UBound(matrix)
   If n = 1 Then det = matrix(1, 1): Exit Function
   
   ReDim minor(1 To n - 1, 1 To n - 1)
 
   For j = 1 To n 'по первой строке
         For i_ = 1 To n - 1
            For j_ = 1 To n - 1
               If j_ < j Then minor(i_, j_) = matrix(i_ + 1, j_)
               If j_ >= j Then minor(i_, j_) = matrix(i_ + 1, j_ + 1)
            Next j_
         Next i_
      det = det + (-1) ^ (1 + j) * matrix(1, j) * det(minor)
   Next j
End Function
 
Private Sub Command1_Click()
   Dim i As Integer, j As Integer
   n = CInt(InputBox("Число строк")) 'матрица ТОЛЬКО квадратная
   ReDim A(1 To n, 1 To n) As Single
 
   For i = 1 To n
      For j = 1 To n
         A(i, j) = InputBox("a(" & i & " , " & j & " ) ")
         Text1.Text = Text1.Text & A(i, j) & ""
      Next j
      Text1.Text = Text1.Text + vbCrLf
   Next i
   MsgBox det(A) 'Call det(matrix) - бред {Function det, а не Sub det}
End Sub

Работает, проверил!!! Имена контролов только подкорректировать - сделано для VB!

@ikki · 09.06.2012, 04:16

Апострофф, гм...

ну так-то да... всё правильно.
но... это не метод Гаусса жеж

@Meigas · 09.06.2012, 16:55 **[ТС]**

Опять проблема с этим же кодом - он через раз выдаёт - то 20, то -20, иногда угадывает, иногда не угадывает. Может где еще есть ошибки?

Visual Basic

Dim p As Integer
 
Sub KGAUSS(ByRef Ab(), ByVal N, ByRef X(), IAI)
Dim j As Long 'переменная для реализации неявного цикла "Ab(i,k+1:N+1)"
Dim mx As Double, L As Long
IAI = 1
For k = 0 To N ' Перебор строк - шаги прямого хода
 mx = 0
 L = 0
   For i = k To N
      If Abs(Ab(i, k)) > mx Then L = i: mx = Ab(i, k)
   Next i
     p = p + 1
          For j = 0 To N + 1
         W = Ab(k, j): Ab(k, j) = Ab(L, j): Ab(L, j) = W
         
                                 Next j
      If Ab(k, k) = 0 Then IAI = 0 ' IAI - признак вырожденности системы
      If IAI = 0 Then Exit For ' Выход, если гл. элемент = 0
          For i = k + 1 To N ' Перебор строк с k+1-ой по N-ую
            Ab(i, k) = Ab(i, k) / Ab(k, k)
               For j = k + 1 To N + 1
                 Ab(i, j) = Ab(i, j) - Ab(i, k) * Ab(k, j)
               Next j
          Next i
Next k
For k = N To 0 Step -1 ' Обратная подстановка (обратный ход)
    X(k) = Ab(k, N + 1) / Ab(k, k)
    For j = 0 To N - 1
        Ab(j, N + 1) = Ab(j, N + 1) - Ab(j, k) * X(k)
    Next j
Next k
End Sub
Sub main()
Dim A(2, 3), X(2)
Call FromRangeToMatr(A, 2, 3)
Call KGAUSS(A(), 2, X(), IAI)
Call FromMasToColumn(1, 6, X, 2)
Debug.Print "Определитель:="; Det(A, 2)
End Sub
Function Det(A(), N)
Det = 1
For k = 0 To N
Det = Det * (-1) ^ p * A(k, k)
Next k
End Function

@ikki · 09.06.2012, 17:57

Сообщение от ikki_cf

я не разобрал в деталях Ваш код

таки пришлось
иначе - мне скоро гаусс будет сниться в обнимку с мейгасом

гаусс будет материться как баварский сапожник, а мейгас грустно улыбаться и тихо спрашивать: "ну почему?"

получилось так:

Visual Basic

Option Base 1
Option Explicit
Dim p%, n%
 
Sub KGAUSS(Ab)
  Dim i%, j%, k%, mx#, l%, w#
  For k = 1 To n ' Перебор строк - шаги прямого хода
    mx = 0: l = 0
    For i = k To n
      If Abs(Ab(k, i)) > mx Then l = i: mx = Ab(i, k)
    Next i
    If mx = 0 Then Exit For
    If l > k Then
      p = p + 1
      For j = 1 To n
        w = Ab(k, j): Ab(k, j) = Ab(l, j): Ab(l, j) = w
      Next j
    End If
    For i = k + 1 To n ' Перебор строк с k+1-ой по N-ую
      w = Ab(i, k) / Ab(k, k)
      For j = k To n
        Ab(i, j) = Ab(i, j) - Ab(k, j) * w
      Next j
    Next i
  Next k
End Sub
 
Function Det#(a)
  Dim k%
  Det = (-1) ^ p
  For k = 1 To n
    Det = Det * a(k, k)
  Next k
End Function
 
Sub main()
  Dim a
  n = 3: p = 0
'  Call FromRangeToMatr(A, 2, 3)
  a = [a1:c3].Value
  Call KGAUSS(a)
'  Call FromMasToColumn(1, 6, X, 2)
  Debug.Print "Определитель:="; Det(a)
End Sub

@ikki призрак 3262 / 890 / 119 Регистрация: 11.05.2012 Сообщений: 1,702 Записей в блоге: 2
	29.05.2012, 16:37	2
	честно говоря, тоже не знал о таком методе. узнал здесь 0

@Meigas 4 / 4 / 0 Регистрация: 10.03.2012 Сообщений: 60
	29.05.2012, 16:54 [ТС]	3
	ну вот в том и проблема, что не знаю как привести матрицу к ступенчатому виду (Верхнетреугольная матрица) 0

@ikki призрак 3262 / 890 / 119 Регистрация: 11.05.2012 Сообщений: 1,702 Записей в блоге: 2
	29.05.2012, 17:05	4
	Сообщение от Meigas не знаю как привести матрицу к ступенчатому виду можно было бы ответить вежливо: "с помощью метода Гаусса" (типо - тупой ответ на тупой вопрос), можно было бы дать ссылку на страничку в той же википедию, с описанием алгоритма метода Гаусса и пошаговым примером (предположив, что Вам религия не позволяет искать информацию на форуме и в сети), можно было бы дать советы по циклам и операторам (когда Вы сделаете хоть какой-то, пусть и неправильный вариант)... ...но Вам ведь не это надо? ок. тогда ждите. 0

@ikki призрак 3262 / 890 / 119 Регистрация: 11.05.2012 Сообщений: 1,702 Записей в блоге: 2
	08.06.2012, 14:11	6
	Сообщение от Meigas Проблема в том, что не могу понять, как задать это число перестановок строк. его не надо "задавать". его надо подсчитать. p - это количество перестановок строк, выполненных в ходе работы алгоритма. перестановки в вашем коде выполняются в строках 11-13. 0

@Meigas 4 / 4 / 0 Регистрация: 10.03.2012 Сообщений: 60
	08.06.2012, 14:39 [ТС]	7
	Сообщение от ikki_cf его не надо "задавать". его надо подсчитать. p - это количество перестановок строк, выполненных в ходе работы алгоритма. перестановки в вашем коде выполняются в строках 11-13. Я понимаю, что там происходят перестановки, но все попытки сделать там подсчёт количества перестановок - оказались тщетны. 0

@ikki призрак 3262 / 890 / 119 Регистрация: 11.05.2012 Сообщений: 1,702 Записей в блоге: 2
	08.06.2012, 14:45	8
	Сообщение от Meigas но все попытки сделать там подсчёт мда?.. я ни одной попытки не вижу. 0

@ikki призрак 3262 / 890 / 119 Регистрация: 11.05.2012 Сообщений: 1,702 Записей в блоге: 2
	08.06.2012, 15:17	12
	Сообщение от ikki_cf 1) объявите переменную уровня модуля (перед всеми процедурами) как еще объяснить? 1

@Meigas 4 / 4 / 0 Регистрация: 10.03.2012 Сообщений: 60
	08.06.2012, 15:20 [ТС]	13
	Сообщение от ikki_cf как еще объяснить? Дико извиняюсь за невнимательность, вам огромное спасибо. 0

@ikki призрак 3262 / 890 / 119 Регистрация: 11.05.2012 Сообщений: 1,702 Записей в блоге: 2
	09.06.2012, 04:16	15
	Апострофф, гм... ну так-то да... всё правильно. но... это не метод Гаусса жеж 0