しさく - プログラム倉庫

Function bud(th, c, y) As Single
Dim s As Single
Dim b1 As Single
Dim m 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
Dim w1 As Single
Dim m 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
Dim m As Single
Dim c1 As Single
Dim l1 As Single
Dim u1 As Single
Dim pp As Single
Dim maxu As Single
Dim pre As Single
maxu = -999
pre = 1
For m = 1 To 100
c1 = c(m)
l1 = y(m) / th(s)
pp = 0
If c1 = 0 Then pp = 1
If c1 < 0 Then pp = 1
If l1 < 0 Then pp = 1
If l1 > 0.99 Then pp = 1
If pp = 1 Then c1 = 0.5
If pp = 1 Then l1 = 0.5
u1 = Log(c1) + Log(1 - l1)
If pp = 1 Then u1 = -999
If u1 > maxu Then pre = m
If u1 > maxu Then maxu = u1
Next
prefer = pre
End Function

Private Sub Command1_Click()
Dim s As Single
Dim th(1 To 100) As Single
Dim c(1 To 100) As Single
Dim y(1 To 100) As Single
For s = 1 To 100
th(s) = 0.02 * s
Next
For s = 1 To 100
y(s) = 0.5 * th(s)
c(s) = y(s)
Next
Debug.Print bud(th, c, y)
Debug.Print wel(th, c, y)
End Sub