type2 - プログラム倉庫

Function seeku(th As Single, bp As Single, wp 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
Dim the As Single
Dim u3 As Single
the = 1.1
e = 10 ^ (-5)
h = 0.1
ls = (bp + 0.1) / th
ys = th * ls
cs = th * ls - bp
us = Log(cs) + Log(1 - ls)
ws = Log(cs) + Log(1 - ys / the)
If ws > wp Then us = -999
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)
w1 = Log(c1) + Log(1 - y1 / the)
If w1 > wp Then u1 = -999
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)
w2 = Log(c2) + Log(1 - y2 / the)
If w2 > wp Then u2 = -999
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
u3 = seekuk(th, bp)
If u3 = us Then us = -999
If u3 < us Then us = -999
seeku = us
End Function

Function seekuk(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
seekuk = us
End Function
Private Sub Command1_Click()
Dim u(-20 To 20) As Single
Dim v(-20 To 20, 1 To 100) As Single
Dim b(-20 To 20) As Single
Dim w(1 To 100) As Single
Dim m As Single
Dim n As Single
Dim w0 As Single
Dim ww As Single
Dim th As Single
Dim xs As Single
Dim x1 As Single
Dim x2 As Single
th = 1
For m = -20 To 20
b(m) = 0.01 * m
Next
w0 = Log(0.4) + Log(0.4)
ww = (Log(0.7) + Log(0.7) - w0) / 100
For n = 1 To 100
w(n) = w0 + ww * n
Next
For m = -20 To 20
For n = 1 To 100
v(m, n) = seeku(th, b(m), w(n))
Next
Next
th = 1.1
For m = -20 To 20
u(m) = seekuk(th, b(m))
Next
Dim ms As Single
Dim ms1 As Single
Dim ms2 As Single
Dim ms3 As Single
Dim us As Single
Dim vs As Single
Dim ns As Single
Dim ns1 As Single
Dim ns2 As Single
Dim ns3 As Single
Dim qs As Single
Dim qs1 As Single
Dim qs2 As Single
Dim qs3 As Single
ms = 0.85
ms1 = ms
ms2 = Int(ms1)
ms3 = ms2 + 1
us = u(ms2) + (ms1 - ms2) * (u(ms3) - u(ms2))
ns = -ms
ns1 = ns
ns2 = Int(ns1)
ns3 = ns2 + 1
qs = (us - w0) / ww
qs1 = qs
qs2 = Int(qs1)
qs3 = qs2 + 1
vs = v(ns2, qs2) + (ns1 - ns2) * (v(ns3, qs2) - v(ns2, qs2)) + (qs1 - qs2) * (v(ns2, qs3) - v(ns2, qs2))
Debug.Print ms, vs
End Sub