Visual Basic 6.0 ile yazılmış BİLGİSAYAR PROGRAMI KODU

Option Explicit

'//// Visual Basic 6.0
'//// N Bilinmeyenli N Dogrusal Denklem Cozumu
'//// NxN KARE MATRIS

Public Type MatNxN
A() As Double
Minor() As Double
Determinant As Double
CoFactor() As Double
Transpose() As Double
Inverse() As Double
End Type


Public Type EQN_
N As Long
MATRIS As MatNxN
SABITLER() As Double
SONUCLAR() As Double
End Type

Public EQN As EQN_

Public Function _
DeterminantOf(SqrMatrix() As Double) As Double

Dim i As Integer
Dim j As Integer
Dim CalcTotal As Double
For i = 1 To 1
For j = 1 To UBound(SqrMatrix)
CalcTotal = CalcTotal + SqrMatrix(i, j) * (-1) ^ (i + j) * MinorOf(SqrMatrix, i, j)
Next j
Next i
DeterminantOf = CalcTotal

End Function

Public Function _
MinorOf(SqrMatrix() As Double, EntityRowID As Integer, _
EntityColID As Integer) As Double

If UBound(SqrMatrix) = 1 Then Exit Function
Dim SubMatrix() As Double
DetermineSubMatrix SqrMatrix, EntityRowID, EntityColID, SubMatrix
If UBound(SubMatrix) = 1 Then
MinorOf = SubMatrix(1, 1)

Else
MinorOf = DeterminantOf(SubMatrix)
End If

End Function

Public Sub _
DetermineSubMatrix(SqrMatrix() As Double, EntityRowID As Integer, _
EntityColID As Integer, SubMatrix() As Double)
Dim i As Integer
Dim j As Integer
Dim subI As Integer
Dim subJ As Integer
ReDim SubMatrix(1 To UBound(SqrMatrix) - 1, 1 To UBound(SqrMatrix) - 1)
subI = 1: subJ = 1
For i = 1 To UBound(SqrMatrix)
If i = EntityRowID Then i = i + 1
For j = 1 To UBound(SqrMatrix)
If j = EntityColID Then j = j + 1
SubMatrix(subI, subJ) = SqrMatrix(i, j)
subJ = subJ + 1
If subJ = UBound(SqrMatrix) Then Exit For
Next j
subI = subI + 1
subJ = 1
If subI = UBound(SqrMatrix) Then Exit For
Next i

End Sub


Public Sub _
GetTransposeAndInverse(CoFactor() As Double, Transpose() As Double, _
Inverse() As Double, Det As Double)

Dim i As Integer
Dim j As Integer

For i = 1 To UBound(CoFactor)
For j = UBound(CoFactor) To 1 Step -1
Transpose(j, i) = CoFactor(i, j)
Inverse(j, i) = Transpose(j, i) / Det
Next j
Next i

End Sub

Public Sub Main()

With EQN

'Denklem sayisini kendi ihtiyaciniza gore degistirin, pozitif tamsayi olmalıdır.
.N = 4

ReDim .SABITLER(1 To EQN.N)
ReDim .MATRIS.A(1 To EQN.N, 1 To EQN.N)

' ORNEK DENKLEMLER - BASLANGIC
' X=x1=1 Y=x2=1 Z=x3=1 W=x4=1

' 3X + 4Y + Z + 5W = 13
' 5X + 2Y - 2Z - W = 4
' -2X + Y + 3Z + 2W = 4
' -9X - Y + 2Z + 2W = -6

'Denklem sayisini kadar katsayilarinizi ve sabit degerlerinizi girin, bu örnekte
'4 adet dogrusal denklem kullanilmistir
'1 numarali denklem
.MATRIS.A(1, 1) = 3 'Katsayi X1
.MATRIS.A(1, 2) = 4 'Katsayi X2
.MATRIS.A(1, 3) = 1 'Katsayi X3
.MATRIS.A(1, 4) = 5 'Katsayi X4
.SABITLER(1) = 13 'denklem sonucu sabit sayi

'2 numarali denklem
.MATRIS.A(2, 1) = 5
.MATRIS.A(2, 2) = 2
.MATRIS.A(2, 3) = -2
.MATRIS.A(2, 4) = -1
.SABITLER(2) = 4
'3 numarali denklem
.MATRIS.A(3, 1) = -2
.MATRIS.A(3, 2) = 1
.MATRIS.A(3, 3) = 3
.MATRIS.A(3, 4) = 2
.SABITLER(3) = 4

'4 numarali denklem
.MATRIS.A(4, 1) = -9
.MATRIS.A(4, 2) = -1
.MATRIS.A(4, 3) = 2
.MATRIS.A(4, 4) = 2
.SABITLER(4) = -6

' ORNEK DENKLEMLER - BITIS


ReDim .MATRIS.CoFactor(1 To .N, 1 To .N)
ReDim .MATRIS.Inverse(1 To .N, 1 To .N)
ReDim .MATRIS.Minor(1 To .N, 1 To .N)
ReDim .MATRIS.Transpose(1 To .N, 1 To .N)

Dim i As Integer
Dim j As Integer

For i = 1 To .N
For j = 1 To .N
.MATRIS.Minor(i, j) = MinorOf(.MATRIS.A, i, j)
.MATRIS.CoFactor(i, j) = (-1) ^ (i + j) * .MATRIS.Minor(i, j)
Next j
Next i

.MATRIS.Determinant = DeterminantOf(.MATRIS.A)
If .MATRIS.Determinant = 0 Then
MsgBox "COZUM BULUNAMIYOR! det(A)=0"
Exit Sub
End If

GetTransposeAndInverse .MATRIS.CoFactor, .MATRIS.Transpose, _
.MATRIS.Inverse, .MATRIS.Determinant

ReDim .SONUCLAR(1 To .N)
Dim X As Double

For i = 1 To .N
For j = 1 To .N
X = X + .MATRIS.Inverse(i, j) * .SABITLER(j)
Next j
.SONUCLAR(i) = X
MsgBox "x" & (i) & " = " & Format(.SONUCLAR(i), "#0.00000000")
X = 0#
Next i

MsgBox "Katsayilari ve sabitleri Excel dosyasindan alan kod için:" & vbCr & _
"hrnkilic@gmail.com"

End With

End Sub

Yazar: Harun KILIÇ
İçerik: Harun KILIÇ
Tag: N Bilinmeyenli N Doğrusal Denklem Çözümü NxN Kare Matris Hesaplaması