アットウィキロゴ

きほn

Function mprefer(s1 As Single, s2 As Single, th1, th2, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
maxm = s1
c1 = c(s1, s2)
my = y1(s1, s2)
fy = y2(s1, s2)
maxu = u(s1, s2, th1, th2, c1, my, fy)
For m1 = 1 To 10
For m2 = 1 To 10
c1 = c(m1, m2)
my = y1(m1, m2)
fy = y2(m1, m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
Next
mprefer = maxm
End Function
Function fprefer(s1 As Single, s2 As Single, th1, th2, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
maxm = s2
c1 = c(s1, s2)
my = y1(s1, s2)
fy = y2(s1, s2)
maxu = u(s1, s2, th1, th2, c1, my, fy)
For m1 = 1 To 10
For m2 = 1 To 10
c1 = c(m1, m2)
my = y1(m1, m2)
fy = y2(m1, m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
Next
fprefer = maxm
End Function


Function u(s1 As Single, s2 As Single, th1, th2, cp As Single, yp1 As Single, yp2 As Single) As Single
Dim l1 As Single
Dim l2 As Single
Dim cx As Single
Dim px As Single
l1 = yp1 / th1(s1)
l2 = yp2 / th2(s2)
cx = cp
px = 0
If cx < 0.01 Then px = 1
If l1 > 0.99 Then px = 1
If l2 > 0.99 Then px = 1
If l1 < 0 Then px = 1
If l2 < 0 Then px = 1
If px = 1 Then cx = 0.5
If px = 1 Then l1 = 0.5
If px = 1 Then l2 = 0.5
ux = Log(cx) + Log(1 - l1) + Log(1 - l2)
If px = 1 Then ux = -999
u = ux
End Function

Private Sub Command1_Click()
Dim s1 As Single
Dim s2 As Single
Dim c(1 To 10, 1 To 10) As Single
Dim y1(1 To 10, 1 To 10) As Single
Dim y2(1 To 10, 1 To 10) As Single
Dim th1(1 To 10) As Single
Dim th2(1 To 10) As Single
Open "c:/lupin3.txt" For Input As #1
Do Until EOF(1)
Input #1, a1, a2, a3, a4, a5
s1 = a1
s2 = a2
c(s1, s2) = a3
y1(s1, s2) = a4
y2(s1, s2) = a5
Loop
Close #1
For s = 1 To 10
th1(s) = 0.2 * s
th2(s) = 0.1 * s
Next
For s1 = 1 To 10
For s2 = 1 To 10
If y1(s1, s2) = 0 Then Debug.Print y2(s1, s2), c(s1, s2)
Next
Next




End Sub
最終更新:2009年11月07日 21:46