評価関数 - プログラム倉庫

Function seekv(bp As Single, u, v) As Single
Dim xs As Single
h = 5
xs = bp
n1 = xs
n2 = Int(n1)
n3 = n2 + 1
z1 = u(n2) + (n1 - n2) * (u(n3) - u(n2))
n1 = bp - xs
n2 = Int(n1)
n3 = n2 + 1
z2 = v(n2) + (n1 - n2) * (v(n3) - v(n2))
vs = z1 + z2
t2 = 0
Do Until t2 > 10
t1 = 0
Do Until t1 > 100
x1 = xs + h
n1 = x1
n2 = Int(n1)
n3 = n2 + 1
z1 = u(n2) + (n1 - n2) * (u(n3) - u(n2))
n1 = bp - x1
n2 = Int(n1)
n3 = n2 + 1
z2 = v(n2) + (n1 - n2) * (v(n3) - v(n2))
v1 = z1 + z2
x2 = xs - h
n1 = x2
n2 = Int(n1)
n3 = n2 + 1
z1 = u(n2) + (n1 - n2) * (u(n3) - u(n2))
n1 = bp - x2
n2 = Int(n1)
n3 = n2 + 1
z2 = v(n2) + (n1 - n2) * (v(n3) - v(n2))
v2 = z1 + z2
t1 = t1 + 1
If v1 > vs Then xs = x1
If v1 > vs Then vs = v1
If v2 > vs Then xs = x2
If v2 > vs Then vs = v2
If (xs - xp) ^ 2 < 10 ^ (-8) Then t1 = 1000
xp = xs
Loop
h = h / 2
t2 = t2 + 1
Loop
seekv = vs
End Function

Function seeku(th As Single, bp As Single) As Single
Dim ls As Single
Dim cs As Single
Dim us As Single
Dim ys As Single
Dim ws As Single
Dim l1 As Single
Dim c1 As Single
Dim u1 As Single
Dim l2 As Single
Dim y2 As Single
Dim y1 As Single
Dim c2 As Single
Dim u2 As Single
Dim h As Single
Dim lp As Single
Dim t1 As Single
Dim t2 As Single
Dim e As Single
Dim s As Single
e = 10 ^ (-5)
h = 0.1
ls = (bp + 0.1) / th
ys = th * ls
cs = th * ls - bp
us = Log(cs) + Log(1 - ls)
t2 = 0
Do Until t2 > 10
t1 = 0
Do Until t1 > 100
l1 = ls + h
If l1 > 0.99 Then l1 = ls
c1 = th * l1 - bp
y1 = th * l1
u1 = Log(c1) + Log(1 - l1)
l2 = ls - h
If l2 < 0.01 Then l2 = ls
c2 = th * l2 - bp
If c2 < 0.01 Then l2 = ls
c2 = th * l2 - bp
u2 = Log(c2) + Log(1 - l2)
If u1 > us Then ls = l1
If u1 > us Then us = u1
If u2 > us Then ls = l2
If u2 > us Then us = u2
If (lp - ls) ^ 2 < e Then t1 = 1000
lp = ls
t1 = t1 + 1
Loop
h = h / 2
t2 = t2 + 1
Loop
seeku = us
End Function
Private Sub Command1_Click()
Dim u(-100 To 100) As Single
Dim v(-100 To 100) As Single
Dim b(-100 To 100) As Single
Dim w(1 To 100) As Single
Dim m As Single
Dim n As Single
Dim w0 As Single
Dim th As Single
Dim xs As Single
Dim x1 As Single
Dim x2 As Single
th = 1
For m = -100 To 100
b(m) = 0.003 * m
Next
For m = -100 To 100
v(m) = seeku(th, b(m))
Next
th = 1.07
For m = -100 To 100
u(m) = seeku(th, b(m))
Next
For m = -50 To 50
Debug.Print seekv(m, u, v)
Next
End Sub