kanu - プログラム倉庫

Function seekmu(avg As Single, sig As Single) As Single
Dim m1 As Single
Dim m2 As Single
Dim m3 As Single
Dim a1 As Single
Dim a2 As Single
m1 = 0
m2 = 0.2
a1 = seekav(m1, sig)
t = 0
Do Until t > 100
a2 = seekav(m2, sig)
m3 = m2 + (avg - a2) * (m2 - m1) / (a2 - a1)
m1 = m2
m2 = m3
a1 = a2
If (avg - a2) ^ 2 < 10 ^ (-5) Then t = 1000
t = t + 1
Loop
seekmu = m2
End Function
Function seekav(mu As Single, sig As Single) As Single
Dim avg As Single
Dim p As Single
avg = 0
For n = 1 To 100
p = 0.01 * n - 0.005
a1 = seeky(mu, sig, p)
avg = avg + Exp(a1)
Next
seekav = avg / 100
End Function
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
Dim avg As Single
mu = 0
sig = 0.39
avg = seekav(mu, sig)
sig = 0.7
mu = seekmu(avg, sig)
For n = 1 To 100
p = 0.01 * n - 0.005
a1 = seeky(mu, sig, p)
th(n) = Exp(a1)
Next
Open "c:/501.txt" For Output As #1
For s = 1 To 100
Write #1, s, th(s)
Next
Close #1
End Sub