mukasi - プログラム倉庫

Function check(c) As Single
Dim h As Single
Dim m As Single
h = 0
For m = 1 To 10
If c(m - 1) > c(m) Then h = h + 1
If c(m) - c(m - 1) > 0.1 Then h = h + 1
Next
check = h
End Function

Function bud(th, c, y) As Single
Dim s As Single
b1 = 0
For s = 1 To 100
m = prefer(s, th, c, y)
b1 = b1 + y(m) - c(m)
Next
bud = b1
End Function
Function wel(th, c, y) As Single
Dim s As Single
w1 = 0
For s = 1 To 100
m = prefer(s, th, c, y)
w1 = w1 + Log(c(m)) + Log(1 - y(m) / th(s))
Next
wel = w1
End Function
Function prefer(s As Single, th, c, y) As Single
maxu = -999
For m = 0 To 10
c1 = c(m)
l1 = y(m) / th(s)
pp = 0
If l1 > 0.99 Then pp = 1
If pp = 1 Then l1 = 0.5
u1 = Log(c1) + Log(1 - l1)
If pp = 1 Then u1 = -999
If u1 > maxu Then maxm = m
If u1 > maxu Then maxu = u1
Next
prefer = maxm
End Function
Private Sub Command1_Click()
Dim s As Single
Dim th(1 To 100) As Single
Dim cs(0 To 10) As Single
Dim c(0 To 10) As Single
Dim y(0 To 10) As Single
Dim x(0 To 10) As Single
h = 0.01
For m = 0 To 10
y(m) = 0.1 * m
cs(m) = 0.95 * y(m)
Next
cs(0) = 0.03
For m = 0 To 10
c(m) = cs(m)
Next
For s = 1 To 100
th(s) = 0.02 * s
Next
maxw = -600
h = 0.005
t2 = 0
Do Until t2 > 10
t1 = 0
Do Until t1 > 2000
For m = 0 To 10
Randomize
X1 = Rnd()
x(m) = 0
If X1 > 0.7 Then x(m) = 1
If X1 < 0.3 Then x(m) = -1
Next
For m = 0 To 10
c(m) = cs(m) + x(m) * h
Next
w1 = wel(th, c, y)
b1 = bud(th, c, y)
c1 = check(c)
If b1 < 0 Then w1 = -999
If c1 > 0.5 Then w1 = -999
For m = 0 To 10
If w1 > maxw Then cs(m) = c(m)
Next
If w1 > maxw Then maxw = w1
t1 = t1 + 1
Loop
Debug.Print t2, maxw
t2 = t2 + 1
h = h / 2
Loop
For m = 1 To 10
Y1 = y(m) - y(m - 1)
c1 = c(m) - c(m - 1)
Debug.Print y(m - 1), 1 - c1 / Y1
Next


End Sub