途中 - プログラム倉庫

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 q As Single
Dim th(1 To 100) As Single
Dim cs(1 To 100, -1 To 1) As Single
Dim ys(1 To 100, -1 To 1) 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
Open "c:/701.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4
s = a1
q = a2
cs(s, q) = a3
ys(s, q) = a4
Loop
Close #2
For s = 1 To 100
c(s) = cs(s, 0)
y(s) = ys(s, 0)
Next
Debug.Print bud(th, c, y)
Debug.Print wel(th, c, y)
End Sub