Public Class Form1
Function lx(ByVal th1 As Single, ByVal tl As Single, ByVal tr As Single) As Single
Dim ls As Single
ls = ((1 - tl) * th1 - tr) / (2 * (1 - tl) * th1)
If ls < 0 Then ls = 0
lx = ls
End Function
Function cx(ByVal th1 As Single, ByVal tl As Single, ByVal tr As Single) As Single
Dim ls As Single
ls = ((1 - tl) * th1 - tr) / (2 * (1 - tl) * th1)
If ls < 0 Then ls = 0
cx = (1 - tl) * th1 * ls + tr
End Function
Function tls() As Single
Dim maxw As Single
Dim tl As Single
Dim tr As Single
Dim tp As Single
Dim w1 As Single
Dim n As Single
Dim th(100) As Single
Dim s As Single
For s = 1 To 100
th(s) = 0.02 * s
Next
maxw = -999
For n = 1 To 400
tl = 0.001 * n
tr = trs(tl)
w1 = wel(tl, tr)
If w1 > maxw Then tp = tl
If w1 > maxw Then maxw = w1
Next
tls = tp
End Function
Function trs(ByVal tl As Single) As Single
Dim tr1 As Single
Dim tr2 As Single
Dim tr3 As Single
Dim b1 As Single
Dim b2 As Single
Dim t As Single
tr1 = 0
tr2 = 0.1
t = 0
Do Until t > 100
b1 = bud(tl, tr1)
b2 = bud(tl, tr2)
tr3 = tr2 - b2 * (tr2 - tr1) / (b2 - b1)
tr1 = tr2
tr2 = tr3
If (tr1 - tr2) ^ 2 < 10 ^ (-5) Then t = 1000
t = t + 1
Loop
trs = tr2
End Function
Function wel(ByVal tl As Single, ByVal tr As Single) As Single
Dim w1 As Single
Dim s As Single
Dim ls As Single
Dim cs As Single
Dim th1 As Single
Dim th(100) As Single
For s = 1 To 100
th(s) = 0.02 * s
Next
w1 = 0
For s = 1 To 100
th1 = th(s)
ls = lx(th1, tl, tr)
If ls < 0 Then ls = 0
cs = cx(th1, tl, tr)
w1 = w1 + Math.Log(cs) + Math.Log(1 - ls)
Next
wel = w1
End Function
Function bud(ByVal tl As Single, ByVal tr As Single) As Single
Dim s As Single
Dim ls As Single
Dim cs As Single
Dim ys As Single
Dim th1 As Single
Dim th(100) As Single
For s = 1 To 100
th(s) = 0.02 * s
Next
ys = 0
cs = 0
For s = 1 To 100
th1 = th(s)
ls = lx(th1, tl, tr)
ys = ys + th(s) * ls
cs = cs + cx(th1, tl, tr)
Next
bud = ys - cs
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim th(100) As Single
Dim s As Single
Dim tl As Single
Dim tr As Single
Dim y(100) As Single
Dim c(100) As Single
Dim th1 As Single
For s = 1 To 100
th(s) = 0.02 * s
Next
tl = tls()
tr = trs(tl)
For s = 1 To 100
th1 = th(s)
y(s) = th(s) * lx(th1, tl, tr)
c(s) = cx(th1, tl, tr)
Next
Dim m As Single
Dim n As Single
Dim ms As Single
Dim ns As Single
Dim mx As Single
Dim nx As Single
Dim mxs As Single
Dim nxs As Single
Dim q As Single
Dim c1 As Single
Dim y1 As Single
Dim c2 As Single
Dim y2 As Single
Dim u(100, 3, 3) As Single
Dim w(99, 3, 3) As Single
Dim gotoc(99, 3, 3, 20) As Single
Dim gotoy(99, 3, 3, 20) As Single
Dim gotoq(99, 3, 3, 20) As Single
Dim v(99, 3, 3, 20) As Single
Dim opc(100) As Single
Dim opy(100) As Single
Dim opq(100) As Single
Dim w1 As Single
Dim wp As Single
Dim bp As Single
Dim h As Single
Dim bb As Single
Dim s1 As Single
Dim time As Single
Dim l1 As Single
Dim pp As Single
Dim u1 As Single
Dim qx As Single
Dim t As Single
Dim vs As Single
Dim v1 As Single
Dim ep As Single
h = 10 ^ (-2)
time = 1
Do Until time > 1000
For s = 1 To 99
For m = -1 To 1
For n = -1 To 1
c1 = c(s) + m * h
y1 = y(s) + n * h
l1 = y1 / th(s)
pp = 0
If l1 < 0 Then pp = 1
If l1 < 0 Then l1 = 0
If l1 > 0.99 Then pp = 1
If l1 > 0.99 Then l1 = 0.99
If c1 < 0.01 Then pp = 1
If c1 < 0.01 Then c1 = 0.01
u(s, m + 1, n + 1) = Math.Log(c1) + Math.Log(1 - l1)
If pp = 1 Then u(s, m + 1, n + 1) = -999
Next
Next
Next
For s = 1 To 99
For m = -1 To 1
For n = -1 To 1
c1 = c(s) + m * h
y1 = y(s) + n * h
l1 = y1 / th(s + 1)
pp = 0
If l1 < 0 Then pp = 1
If l1 < 0 Then l1 = 0
If l1 > 0.99 Then pp = 1
If l1 > 0.99 Then l1 = 0.99
If c1 < 0.01 Then pp = 1
If c1 < 0.01 Then c1 = 0.01
w(s, m + 1, n + 1) = Math.Log(c1) + Math.Log(1 - l1)
If pp = 1 Then w(s, m + 1, n + 1) = -999
Next
Next
Next
For s = 1 To 99
For m = -1 To 1
For n = -1 To 1
For q = -10 To 10
v(s, m + 1, n + 1, q + 10) = -999
Next
Next
Next
Next
s = 1
For m = -1 To 1
For n = -1 To 1
q = n - m
v(s, m + 1, n + 1, q + 10) = u(s, m + 1, n + 1)
Next
Next
For s = 2 To 99
For m = -1 To 1
For n = -1 To 1
For q = -10 To 10
u1 = u(s, m + 1, n + 1)
c1 = c(s) + m * h
y1 = y(s) + n * h
qx = q + m - n
pp = 0
If qx > 10 Then pp = 1000
If qx < -10 Then pp = 1000
If pp > 50 Then qx = 0
vs = -999
For mx = -1 To 1
For nx = -1 To 1
v1 = u1 + v(s - 1, mx + 1, nx + 1, qx + 10)
w1 = w(s - 1, mx + 1, nx + 1)
If w1 > u1 Then v1 = -999
If v1 > vs Then mxs = mx
If v1 > vs Then nxs = nx
If v1 > vs Then vs = v1
Next
Next
If pp > 50 Then vs = -999
gotoc(s, m + 1, n + 1, q + 10) = mxs
gotoy(s, m + 1, n + 1, q + 10) = nxs
gotoq(s, m + 1, n + 1, q + 10) = qx
v(s, m + 1, n + 1, q + 10) = vs
Next
Next
Next
Next
s = 100
vs = -999
For m = -1 To 1
For n = -1 To 1
c1 = c(100) + m * h
y1 = y(100) + n * h
u1 = Math.Log(c1) + Math.Log(1 - y1 / th(100))
qx = m - n
For mx = -1 To 1
For nx = -1 To 1
v1 = u1 + v(s - 1, mx + 1, nx + 1, qx + 10)
w1 = w(s - 1, mx + 1, nx + 1)
If w1 > u1 Then v1 = -999
If pp = 1 Then v1 = -999
If v1 > vs Then ms = m
If v1 > vs Then ns = n
If v1 > vs Then mxs = mx
If v1 > vs Then nxs = nx
If v1 > vs Then vs = v1
Next
Next
Next
Next
opc(100) = ms
opy(100) = ns
opc(99) = mxs
opy(99) = nxs
opq(99) = ms - ns
For t = 1 To 98
s = 99 - t
opc(s) = gotoc(s + 1, opc(s + 1) + 1, opy(s + 1) + 1, opq(s + 1) + 10)
opy(s) = gotoy(s + 1, opc(s + 1) + 1, opy(s + 1) + 1, opq(s + 1) + 10)
opq(s) = gotoq(s + 1, opc(s + 1) + 1, opy(s + 1) + 1, opq(s + 1) + 10)
Next
For s = 1 To 100
c(s) = c(s) + opc(s) * h
y(s) = y(s) + opy(s) * h
Next
ep = 0
For s = 1 To 100
ep = ep + opc(s) ^ 2 + opy(s) ^ 2
Next
If ep < 5 Then h = h / 2
If h < 10 ^ (-4) Then time = 10000
time = time + 1
Loop
Dim mrate(99) As Single
Dim dc As Single
Dim dy As Single
For s = 1 To 99
dc = c(s + 1) - c(s)
dy = y(s + 1) - y(s)
If dy > 0 Then mrate(s) = 1 - dc / dy
Next
Dim g As Graphics = PictureBox1.CreateGraphics()
Dim x1 As Single
Dim x2 As Single
For s = 1 To 98
x1 = 100 * y(s)
x2 = 100 * y(s + 1)
y1 = 100 - 100 * mrate(s)
y2 = 100 - 100 * mrate(s + 1)
g.DrawLine(Pens.Red, x1, y1, x2, y2)
Next
g.DrawLine(Pens.Black, 0, 100, 300, 100)
g.DrawLine(Pens.Black, 0, 0, 0, 200)
End Sub
End Class
最終更新：2009年12月11日 08:49
