m1 m1 - プログラム倉庫

Function seeky(mu As Single, sig As Single, p As Single) As Single
Dim y1 As Single
Dim y2 As Single
Dim p1 As Single
Dim p2 As Single
y1 = -1.1
y2 = 1.1
p1 = g(mu, sig, y1)
s = 0
Do Until s > 100
p2 = g(mu, sig, y2)
y3 = y2 + (p - p2) * (y2 - y1) / (p2 - p1)
y1 = y2
y2 = y3
p1 = p2
If (p - p2) ^ 2 < 10 ^ (-5) Then s = 1000
s = s + 1
Loop
seeky = y2
End Function

Function g(mu As Single, sig As Single, y As Single) As Single
Dim z As Single
Dim h As Single
Dim n As Single
Dim x As Single
Dim t As Single
z = 0
h = 0.001
t = y / h
For n = -2000 To t
x = n * h
z = z + h * f(mu, sig, x)
Next
g = z
End Function

Function f(mu As Single, sig As Single, x As Single) As Single
Dim y As Single
Dim pi As Single
Dim x1 As Single
Dim x2 As Single
pi = 3.1415
x2 = -(x - mu) ^ 2 / (2 * sig ^ 2)
x3 = Exp(x2)
x1 = sig * Sqr(2 * pi)
f = x3 / x1
End Function
Private Sub Command1_Click()
Dim p As Single
Dim n As Single
Dim mu As Single
Dim sig As Single
Dim h As Single
Dim th(1 To 100) As Single
mu = 0
sig = 0.39
x = 0
y = 0.4
For n = 1 To 100
p = 0.01 * n - 0.005
a1 = seeky(mu, sig, p)
th(n) = Exp(a1)
Next
Open "c:/m1.txt" For Output As #1
For s = 1 To 100
Write #1, s, th(s)
Next
Close #1
End Sub