[VBA ] 在EXCEL巨集裡用牛頓法及妙樂法解方程꘠…
假使某城市人口隨時減退,方程式為Pu(t)=60000*(e^-0.04t)+120000
假使某鄉鎮人口隨時增加,方程式為Ps(t)=300000/1+((300000/5000)-1)*(e^-0.06t)
Pu(t)=Ps(t)需經過幾年,人口數多少?
Sub vb11()
Dim X0 As Double, X1 As Double, E As Double, N As Double
Cells(2, 1) = "X"
Cells(3, 1) = "次數"
Cells(4, 1) = "FX"
Cells(1, 3) = "妙樂法"
Cells(1, 2) = "牛頓法"
X0 = 1.5
E = 10 ^ -4
Call newton(X0, X1, E, N)
Cells(2, 2) = X1
Cells(3, 2) = N
F0 = F(X0)
Cells(4, 2) = F0
End Sub
Sub newton(X0 As Double, X1 As Double, E As Double, N As Double)
Dim F0 As Double, F1 As Double, dF0 As Double
N = 0
DX = 0.001
E = 0.0001
F0 = F(X0)
Do Until Abs(F0) < E
F2 = F(X0 + DX)
dF0 = (F2 - F0) / DX
X1 = X0 - F0 / dF0
F0 = F(X1)
X0 = X1
N = N + 1
Loop
End Sub
Sub vb12()
Dim X0 As Double, X1 As Double, X2 As Double, Xr As Double, E As Double, N As Double
X2 = 0
X0 = 1
X1 = 100
E = 10 ^ -4
Call Muller(X0, X1, X2, E, N)
Cells(2, 3) = X0
Cells(3, 3) = N
F0 = F(X0)
Cells(4, 3) = F0
End Sub
Sub Muller(X0 As Double, X1 As Double, X2 As Double, E As Double, N As Double)
Dim F0 As Double, F1 As Double, F2 As Double, Fr As Double, Xr As Double, C As Double
Dim H1 As Double, H2 As Double, D1 As Double, D2 As Double, A As Double, B As Double
N = 0
H1 = X1 - X0
H2 = X0 - X2
r = H2 / H1
F1 = F(X1)
F0 = F(X0)
F2 = F(X2)
A = (r * F1 - F0 * (1 + r) + F2) / (r * H1 ^ 2 * (1 + r))
B = (F1 - F0 - A * H1 ^ 2) / H1
C = F0
D1 = X0 - (2 * C / (B + (B ^ 2 - 4 * B * C) ^ 0.5))
D2 = X0 - (2 * C / (B - (B ^ 2 - 4 * B * C) ^ 0.5))
Do
If Abs(D1 - X0) < Abs(D2 - X0) Then Xr = D1 Else Xr = D2
If Xr > X0 Then
X2 = X0
X0 = Xr
Else
X0 = Xr
X1 = X0
End If
H1 = X1 - X0
H2 = X0 - X2
r = H2 / H1
F1 = F(X1)
F0 = F(X0)
F2 = F(X2)
A = (r * F1 - F0 * (1 + r) + F2) / (r * H1 ^ 2 * (1 + r))
B = (F1 - F0 - A * H1 ^ 2) / H1
C = F0
D1 = X0 - (2 * C / (B + (B ^ 2 - 4 * B * C) ^ 0.5))
D2 = X0 - (2 * C / (B - (B ^ 2 - 4 * B * C) ^ 0.5))
N = N + 1
Loop Until Abs(F0) < E
End Sub
Function F(X As Double) As Double
F = 60000 * Exp(-0.04 * X) + 120000 = 300000 / 1 + ((300000 / 5000) - 1) * Exp(-0.06 * X)
End Function
牛頓法跑出來一直顯示0
妙樂法跑不出來
希望板上的高手幫幫忙
感謝~
--
牙一咬 兩年就過了
http://www.wretch.cc/album/likeconnie
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 140.128.67.249
※ 編輯: nursecc 來自: 140.128.67.249 (12/01 11:31)