حل N معادله N مجهولی

[milade8080]

سلام دوستان، اگر یادتون باشه من میخواستم تو اکسس فرمی داشته باشم برای حل معادله چند مجهولی، پس از کلی جستجو و گذاشتن پیغام یکی از دوستان فرمی را با اکسس برای حل معادله فقط 4*4 برام ایمیل کرده
سئوال: برای معادلات 3*3 و 5*5 یا بیشتر باید چکار کنم؟ ممنون میشم کسی منو راهنمایی کنه؟

لینک دانلود فایل اکسس برای معادلات 4*4
http://www.access-programmers.co.uk/forums/attachment.php?attachmentid=52914&d=1394298480
لینک کمکی

http://www.uplooder.net/cgi-bin/dl.cgi?key=c1d268ffd8c73de71acce9668250532d

[mazoolagh]

حل n معادله n مجهول که مورد نظر شماست رو بهش میگن دستگاه معادلات خطی و برای حل این دستگاه هم روش (آلگوریتم) های مختلفی هست که روش حذف گوسی از همه متداولتر هست و برنامه ای هم که براتون فرستادن باحتمال خیلی زیاد بر مبنای همین الگوریتم هست.
با گوگل کردن آلگوریتمش رو پیدا کنین و از روی اون تغییرات لازم در کد رو اعمال کنین. اگر برنامه خوشرفتار باشه احتمالا تغییرات در حد جایگزین کردن عدد 4 با عدد دلخواه شماست!

[milade8080]

حل n معادله n مجهول که مورد نظر شماست رو بهش میگن دستگاه معادلات خطی و برای حل این دستگاه هم روش (آلگوریتم) های مختلفی هست که روش حذف گوسی از همه متداولتر هست و برنامه ای هم که براتون فرستادن باحتمال خیلی زیاد بر مبنای همین الگوریتم هست.
با گوگل کردن آلگوریتمش رو پیدا کنین و از روی اون تغییرات لازم در کد رو اعمال کنین. اگر برنامه خوشرفتار باشه احتمالا تغییرات در حد جایگزین کردن عدد 4 با عدد دلخواه شماست!

سلام
بابت جوابتون ممنون، مشکل من اینه که از برنامه نویسی هیچی نمیدونم

اینم کد برنامش:

Option Compare Database

Private Sub Solve_Click()
Dim a(4, 4) As Double
Dim b(4) As Double
Dim n As Integer
Dim temp As Double

n = UBound(a, 1)

'read the values from the form
For r = 1 To n
For c = 1 To n
a(r, c) = Nz(Me.Controls("a" & r & c), 0)
Next c
b(r) = Nz(Me.Controls("b" & r), 0)
Next r

'reduce to triangular form
For c = 1 To n - 1
'swap rows if necessary
For r = c + 1 To n
If Abs(a(r, c)) > Abs(a(c, c)) Then
'swap the rows
For i = c To n
temp = a(c, i)
a(c, i) = a(r, i)
a(r, i) = temp
Next i
temp = b(c)
b(c) = b(r)
b(r) = temp
End If
Next r
For r = c + 1 To n
factor = a(r, c) / a(c, c)
For i = c To n
a(r, i) = a(r, i) - factor * a(c, i)
Next i
b(r) = b(r) - factor * b(c)
Next r
Next c

'Back substitute and solve
For r = n To 1 Step -1
If r <> n Then
For c = r + 1 To n
b(r) = b(r) - a(r, c) * b(c)
a(r, c) = 0
Next c
End If
b(r) = b(r) / a(r, r)
a(r, r) = 1
Next r

'output the solution to the form
For r = 1 To n
Me.Controls("s" & r) = b(r)
Next r

End Sub


Private Sub printMatrix(ByRef a() As Double, ByRef b() As Double)
'this is used only for debugging
n = UBound(a, 1)
Debug.Print
For r = 1 To n
For c = 1 To n
Debug.Print Tab(c * 8 - 7);
Debug.Print Round(a(r, c), 2);
Next c
Debug.Print Tab(n * 8 + 8);
Debug.Print Round(b(r), 2)
Next r
End Sub

---------------------------------------------------
کد بالا را برای معادلات 5 مجهولی دستکاری کردم ولی با یک ارر مواجه شدم به شکل زیر :

http://upload7.ir/imgs/2014-03/96200347990642613653.jpg

[mazoolagh]

برنامه خوش رفتار نیست و برای 4 مجهول هاردکد شده. البته ایرادهای دیگه ای هم داره مثلا اگر دستگاه جواب نداشته باشه نمیتونه تشخیص بده
موقتا بصورت زیر تغییرش بدین و بعد ظاهرش رو هر طور دوست داشتین بسازین:
همه کنترلها بجز باتن SOLVE رو حذف کنین


Private Sub Solve_Click()
Dim A() As Double
Dim B() As Double
Dim N As Integer
Dim r, c, i As Integer
Dim temp, factor As Double
try:
N = InputBox("number of variables (1 to 10)")
If N < 1 Or N > 10 Then GoTo try
ReDim A(1 To N, 1 To N)
ReDim B(1 To N)


'read the values from the form
For r = 1 To N
For c = 1 To N
'A(r, c) = Nz(Me.Controls("a" & r & c), 0)
A(r, c) = InputBox("A(" + Trim(r) + "," + Trim(c) + ")")
Next c
'B(R) = Nz(Me.Controls("b" & R), 0)
B(r) = InputBox("B(" + Trim(r) + ")")
Next r


'reduce to triangular form
For c = 1 To N - 1
'swap rows if necessary
For r = c + 1 To N
If Abs(A(r, c)) > Abs(A(c, c)) Then
'swap the rows
For i = c To N
temp = A(c, i)
A(c, i) = A(r, i)
A(r, i) = temp
Next i
temp = B(c)
B(c) = B(r)
B(r) = temp
End If
Next r
For r = c + 1 To N
factor = A(r, c) / A(c, c)
For i = c To N
A(r, i) = A(r, i) - factor * A(c, i)
Next i
B(r) = B(r) - factor * B(c)
Next r
Next c


'Back substitute and solve
For r = N To 1 Step -1
If r <> N Then
For c = r + 1 To N
B(r) = B(r) - A(r, c) * B(c)
A(r, c) = 0
Next c
End If
B(r) = B(r) / A(r, r)
A(r, r) = 1
Next r


'output the solution to the form
For r = 1 To N
'Me.Controls("s" & R) = B(R)
MsgBox ("X(" + Trim(r) + ")=" + Str(B(r)))
Next r
End Sub