VPF::Как решить систему линейных уравнений?

cardinal

Дата 15.2.2006, 19:02 (ссылка)

(нет голосов)

Загрузка ...

Инженер

Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99

Понадобилось мне решить систему линейных уравнений.
Я такую програмку уже, наверное, раз 20 писал на разных языках, начиная с
алгола А вот для VB почему-то лень стало. Дня три искал везде по сети, но так и не
нашел. Неужели никому не надо?
Короче говоря, сел и написал свою. Может быть она еще кому-нибудь пригодится?

Код


Sub Eq_Sol(a() As Double, b() As Double, x() As Double, n As Integer)
' Решение системы линейных уравнений AX = B
' методом Халецкого (http://www.chat.ru/~alglib/).
' Обращение:
'  Call (A(),B(),X(),N)
' где N - кол-во уравнений (неизвестных), A - матица коэффициентов (N*N),
'       B - столбец (N), X - решение системы (N).
' Метод: матрицу A можно представить в виде A = L*R,
' где L - левая (нижняя) треугольная матрица,
' R - правая (верхняя) треугольная матрица с единицами по диагонали,
' тогда AX = LRX = L(RX) = LY = B,
' т.е. надо решить две простые системы LY = B и затем RX = Y
' Перед обращением следет проверить, что A(1,1) <> 0.
' Имеет ли система решение прграмма не проверяет.

Dim L(1 To 20, 1 To 20), R(1 To 20, 1 To 20), Y(1 To 20)
Dim i As Integer, j As Integer, k As Integer
For i = 1 To n
   L(i, 1) = a(i, 1)
   R(1, i) = a(1, i) / a(1, 1)
Next i
Y(1) = b(1) / a(1, 1)
For i = 2 To n
   R(i, i) = 1
   j = 2
   Do
      L(i, j) = a(i, j)
      R(i, j) = 0
      For k = 1 To j - 1
         L(i, j) = L(i, j) - L(i, k) * R(k, j)
      Next
      j = j + 1
   Loop Until j > i
   R(i, i) = 1
   Do
      L(i, j) = 0
      R(i, j) = a(i, j)
      Y(i) = b(i)
      For k = 1 To i - 1
         R(i, j) = R(i, j) - L(i, k) * R(k, j)
         Y(i) = Y(i) - L(i, k) * Y(k)
      Next
      R(i, j) = R(i, j) / L(i, i)
      Y(i) = Y(i) / L(i, i)
      j = j + 1
   Loop Until j > n
Next
x(n) = Y(n)
For i = n - 1 To 1 Step -1
   x(i) = Y(i)
   For k = i + 1 To n
      x(i) = x(i) - R(i, k) * x(k)
   Next
Next
End Sub

Ответ взят на: www.sources.ru

--------------------

Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино". А. и Б. Стругацкие

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »