prog7 - プログラム倉庫

Function seektheta(p As Single, sig As Single) As Single
Dim x As Single
Dim z1 As Single
Dim y1 As Single
Dim y2 As Single
Dim y3 As Single
Dim g1 As Single
Dim g2 As Single
y1 = -3 * sig
y2 = 3 * sig
g1 = thetag(y1, sig)
t = 0
Do Until t > 100
g2 = thetag(y2, sig)
y3 = y2 + (p - g2) * (y2 - y1) / (g2 - g1)
y1 = y2
y2 = y3
g1 = g2
If (g2 - p) ^ 2 < 10 ^ (-5) Then t = 1000
t = t + 1
Loop
seektheta = Exp(y2)
End Function

Function thetag(y As Single, sig As Single) As Single
Dim n As Single
Dim h As Single
Dim z As Single
Dim x As Single
h = 0.001
z = Int(y / h)
z1 = 0
For n = -5000 To z
x = h * n
z1 = z1 + h * thetaf(x, sig)
Next
thetag = z1
End Function
Function thetaf(x As Single, sig As Single) As Single
Dim pi As Single
Dim x1 As Single
Dim x2 As Single
pi = 3.1415
x1 = Sqr(2 * pi) * sig
x2 = Exp(-x ^ 2 / (2 * sig ^ 2))
thetaf = x2 / x1
End Function
Private Sub Command1_Click()
Dim sig As Single
Dim p As Single
Dim n As Single
Dim th(1 To 100) As Single
sig = 0.1
For n = 1 To 10
p = -0.05 + 0.1 * n
th(n) = seektheta(p, sig)
Debug.Print p, th(n)
Next
End Sub