Bölüm indeksi
Makaleler
Sık Sorulan Sorular
Download
İzle Öğren
Eğitim Videoları
AutoCAD Videoları
3ds Max Videoları
AutoCAD Kursu Ders Videoları
AutoCAD Kursu 2 Boyut Dersleri
AutoCAD Kursu 3 Boyut Dersleri
Proje Dökümanları
Çizimler
Mimari Çizimler
Elektrik
Doğalgaz
Harita Çizimleri
Tesisat
Ferforje
Makine
3 Boyut
3ds Max
ArchiCAD
Solidworks
Diğer Çizimler
Lispler
Menüler
Fontlar
FreeMUST
Eğitim Dökümanları
Genel Kategori
Çizim Programları
IES Dökümanları
AutoCAD
AutoLISP
Konu Anlatımları
Örnek Lispler
Sürümler
Menüler
DWF Dosyaları
Programlama
AutoCAD’d.
C ve C++ ile Au.
C++ ile ARX pro.
VB veya Not Def.
Visual Basic do.
AutoCAD VBA Mak.
AutoCAD VB > Ex.
N Bilinmeyenli .
Visual Basic 6..
AutoCAD Püfleri
Eğitim
AutoCAD Eğitimi
Karma 3 Boyut Dersleri
Adım Adım AutoCAD Eğitimi
01.Bölüm
02.Bölüm
03.Bölüm
04.Bölüm
05.Bölüm
06.Bölüm
07.Bölüm
08.Bölüm
09.Bölüm
10.Bölüm
11.Bölüm
12.Bölüm
Uygulamalar
Adım Adım 3 Boyut Eğitimi
Kariyer
3ds Max
Attribute lar
Sık Sorulan Sorular
Download
İzle Öğren
Eğitim Videoları
AutoCAD Videoları
3ds Max Videoları
AutoCAD Kursu Ders Videoları
AutoCAD Kursu 2 Boyut Dersleri
AutoCAD Kursu 3 Boyut Dersleri
Proje Dökümanları
Çizimler
Mimari Çizimler
Elektrik
Doğalgaz
Harita Çizimleri
Tesisat
Ferforje
Makine
3 Boyut
3ds Max
ArchiCAD
Solidworks
Diğer Çizimler
Lispler
Menüler
Fontlar
FreeMUST
Eğitim Dökümanları
Genel Kategori
Çizim Programları
IES Dökümanları
AutoCAD
AutoLISP
Konu Anlatımları
Örnek Lispler
Sürümler
Menüler
DWF Dosyaları
Programlama
AutoCAD’d.
C ve C++ ile Au.
C++ ile ARX pro.
VB veya Not Def.
Visual Basic do.
AutoCAD VBA Mak.
AutoCAD VB > Ex.
N Bilinmeyenli .
Visual Basic 6..
AutoCAD Püfleri
Eğitim
AutoCAD Eğitimi
Karma 3 Boyut Dersleri
Adım Adım AutoCAD Eğitimi
01.Bölüm
02.Bölüm
03.Bölüm
04.Bölüm
05.Bölüm
06.Bölüm
07.Bölüm
08.Bölüm
09.Bölüm
10.Bölüm
11.Bölüm
12.Bölüm
Uygulamalar
Adım Adım 3 Boyut Eğitimi
Kariyer
3ds Max
Attribute lar
AutoCAD Genel
AutoCAD Eğitimi
3ds Max
Özel Yazılımlar
- aLd Fonksiyonu
- TCad Metraj
- FacadeCAD
- Cephe Kot
- HQ Library
- FreeMUST
- ALS/Pasdoc.A
- Excele Tablo Aktaran Lisp
- Nokta Koordinat Tablosu
- Plana İç Ölçü Verme
- Toplam Alanı Yazan Lisp
- Alan ve Çevre Yazan Lisp
- Koordinat, Alan ve Çevre Tablo Halinde Yazma
- AutoCAD'de Nokta Dökümü
- Hava Kanalı Metraj Fonksiyonu
- Boru Metrajı Fonksiyonu
- OptiCAD
- Özel Çizgi Tipi Oluşturmak
- AutoCAD te Koni Açılımı Nasıl Yapılır?
- PolyLine & Point Objelerinden Aplikasyon Çizelgesi
- Z değerini sıfırlama
- AutoCAD te Polyline üzerine uzunluk yazdırma
- Sıralı numaralandırma
- Yazı içindeki sayıları toplama
- Karmaşık Path ile Loft Uygulaması
- Çoklu Fillet Fonksiyonu
- Ölçekli Türk Bayrağı çizen lisp
- Duvar-Lento-Kapı-Pencere Metraj Programı
N Bilinmeyenli N Doğrusal Denklem Çözümü
NxN Kare Matris Hesaplaması
harunkilic - 19.09.2006 13:40
harunkilic - 19.09.2006 13:40
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
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ı
Yorumlar :
hyr 23.01.2010 11:49 #12340
MsgBox "Burası AutoCad Okulu." & vbCrLf & "Lütfen yazdığınız form başlığına bakarak tekrar deneyiniz", 16, "Hata"
bturcan 07.01.2009 15:08 #10101
çok güzel
cunal 28.08.2007 12:14 #5272
Harun bey eline saglık,
iyi güzel yazmıssın lakin ben programcı degilim, ama hevesliyim.
Bu ne işimize yarar nerede kullanabiliriz.
Şoyle bide acıklayıcı bilgilendirici birde yorum yazsan çok mutlu edersin beni.
inanıyorumki başkalarıda cok mutlu olur bu duruma.