Страница: 1 |
люди добрые, просветите меня плз. написал пару функций для определения детерминанта матрицы, но уже на 7 порядке матрицы программа работает неумолимо долго, вот она, може кто подскажет с оптимизацией? пример как использовать: Const s = 7 Dim m(s, s) As Double Dim i, y As Integer For i = 0 To s For y = 0 To s m(i, y) = Rnd(100) Next Next MsgBox(Matrix.Determinante(m)) сам класс: Class Matrix Public Shared Function Determinante2x2(ByRef M(,) As Double) As Double ' If Not (UBound(M) <= 1 Or UBound(M, 2) <= 1) Then Throw New ArgumentOutOfRangeException("M", M, "Матрица должна быть 2х2!") If UBound(M) = 0 Then Return M(0, 0) End If Return (M(0, 0) * M(1, 1) - M(0, 1) * M(1, 0)) End Function Public Shared Function Determinante3x3(ByRef M(,) As Double) As Double Return (M(0, 0) * M(1, 1) * M(2, 2) + M(1, 0) * M(2, 1) * M(0, 2) + M(0, 1) * M(1, 2) * M(2, 0) - M(0, 2) * M(1, 1) * M(2, 0) - M(0, 1) * M(1, 0) * M(2, 2) - M(0, 0) * M(1, 2) * M(2, 1)) End Function Public Shared Function Determinante(ByRef M(,) As Double) As Double Dim i, j, ub, ubm As Integer Dim MinorM(,) As Double Dim res As Double ub = UBound(M) For i = 0 To ub For j = 0 To ub 'UBound(M, 2) MinorM = Minor(M, 0, j) ubm = UBound(MinorM) If ubm = 1 Then res += ((-1) ^ (i + j + 2)) * M(i, j) * Determinante2x2(MinorM) ElseIf ubm = 2 Then res += ((-1) ^ (i + j + 2)) * M(i, j) * Determinante3x3(MinorM) Else res += ((-1) ^ (i + j + 2)) * M(i, j) * Determinante(MinorM) End If Next Next Return res End Function Public Shared Function Minor(ByRef mat(,) As Double, ByVal m%, ByVal n%) As Array Dim ub As Integer ub = UBound(mat) Dim res(ub - 1, ub - 1) As Double Dim i, j, dI, dJ As Integer dI = 0 For i = 0 To ub For j = 0 To ub If i <> m And j <> n Then If i > m Then dI = 1 If j > n Then dJ = 1 res(i - dI, j - dJ) = mat(i, j) dI = 0 dJ = 0 End If Next Next Return res End Function end class
А ты уверен что надо самому писать такие вещи? Посмотри библиотеку IMSL, она входит в состав сдандартного фортрана, там почти вся математика реализована!!! Напиши dll и все!! Страница: 1 |
Вопрос: Matrix
Добавлено: 17.05.04 20:10
Автор вопроса: Артём Л. | ICQ: 280044491
Ответы
Всего ответов: 6
Номер ответа: 1
Автор ответа:
Sharp
Лидер форума
ICQ: 216865379
Вопросов: 106
Ответов: 9979
Web-сайт:
Профиль | | #1
Добавлено: 22.05.04 00:51
Делал я такую вещь, но медленно работать начинало только с 9 Попробуй убрать класс, оставив только рекурсию, VB весьма криво реализует ООП. Если не влом, попробуй использовать не минорный способ, а прямое вычисление через транспозиции, их перечисление есть в статье Павла на этом сайте, нахождение знака транспозиции - в любом учебнике по линалу (если не найдешь, пиши)
Номер ответа: 2
Автор ответа:
sania-tngf
Вопросов: 16
Ответов: 21
Профиль | | #2
Добавлено: 22.05.04 11:33
Номер ответа: 3
Автор ответа:
Артём Л.
ICQ: 280044491
Вопросов: 43
Ответов: 227
Профиль | | #3
Добавлено: 22.05.04 14:12
Привет!
>А ты уверен что надо самому писать такие вещи? Посмотри библиотеку IMSL,
она входит в состав сдандартного фортрана, там почти вся математика
реализована!!! Напиши dll и все!!
я ж не комерческую программу пишу - а так, для себя решил попробовать
математические способности .нет. Конечно я уверен, что уже давно существуют
куча библиотек посвященных этому, но своими руками всегда интереснее...
Вообщето выход я нашел, просто я выбрал не самый оптимальный способ, но зато
он оказался самым простым в описании математикой и поэтому на какой сайт не
заглядывал все предлагали именно минорный способ.
Но порывшись в учебнике за второй курс по лин. алгебре нашел более красивый
способ - Гауса, его конечно одной формулой не запишешь, зато матрицу 150х150
считает за доли секунды, вот код кому интересно:
Public Shared Function Determinante(ByVal M(,) As Double) As Double
Dim i, j, ub, ubm As Integer
Dim res As Double = 1
ub = UBound(M)
'создаем треугольную матрицу
Dim k% = MakeTriangle(M)
For i = 0 To ub
res *= M(i, i)
Next
res *= k
Return res
End Function
Public Shared Function MakeTriangle( M(,) As Double) As Integer
Dim i%, j%, y%, ub%, res%
Dim d, buf As Double
ub = UBound(M)
res = 1
For y = 0 To ub '- 1
For i = ub To y + 1 Step -1
If M(i, y) <> 0 Then
d = -(M(i - 1, y) / M(i, y))
For j = y To ub
M(i - 1, j) = M(i, j) * d + M(i - 1, j)
Next
'make re position
For j = 0 To ub
buf = M(i - 1, j)
M(i - 1, j) = M(i, j)
M(i, j) = buf
'copy
Next 'j
res = -res
Else
'd = -1
End If
Next 'i
Next 'y
Return res
End Function
Номер ответа: 4
Автор ответа:
Sharp
Лидер форума
ICQ: 216865379
Вопросов: 106
Ответов: 9979
Web-сайт:
Профиль | | #4
Добавлено: 23.05.04 00:27
Правда? В VB.NET есть такие вещи?
Номер ответа: 5
Автор ответа:
Артём Л.
ICQ: 280044491
Вопросов: 43
Ответов: 227
Профиль | | #5
Добавлено: 23.05.04 14:20
>Метод Гаусса хорош, но, к сожалению, содержит накапливающиеся ошибки. Лучше
него метод вращения.
что за метод, не слышал, можна лекцию или ссылочку?
>> res *= k
>Правда? В VB.NET есть такие вещи?
ну раз написал и работает значит скорее всего есть)))
так же как i+=1 i-=1 i/=2
Номер ответа: 6
Автор ответа:
Sharp
Лидер форума
ICQ: 216865379
Вопросов: 106
Ответов: 9979
Web-сайт:
Профиль | | #6
Добавлено: 23.05.04 15:59