polk - プログラム倉庫

Function u(s1 As Single, s2 As Single, th1, th2, cp As Single, yp1 As Single, yp2 As Single) As Single
Dim lx 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 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 s2 As Single
Dim m As Single
Dim th1(1 To 100) As Single
Dim th2(1 To 100) As Single
Dim y1(1 To 10, 1 To 10) As Single
Dim y2(1 To 10, 1 To 10) As Single
Dim c(1 To 10, 1 To 10) As Single
Dim x(1 To 10, 1 To 10, 1 To 3, 1 To 10) As Single
Dim gu(1 To 10, 1 To 10) As Single
Dim s1 As Single
Dim rank As Single
Dim s As Single
Dim r1 As Single
Dim x1 As Single
Dim c1 As Single
Dim x2 As Single
Dim t2 As Single
Dim n As Single
For s = 1 To 10
th1(s) = 0.2 * s
th2(s) = 0.1 * s
Next
Open "c:/lupin.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4, a5
s1 = a1
s2 = a2
c(s1, s2) = a3
y1(s1, s2) = a4
y2(s1, s2) = a5
Loop
Close #2
For s1 = 1 To 10
For n = 1 To 10
t2 = 0
Do Until t2 > 100
t1 = 0
Do Until t1 > 100
For s2 = 1 To 10
For rank = 1 To 3
Randomize
r1 = Rnd()
x1 = 0
If r1 > 0.7 Then x1 = 1
If r1 < 0.3 Then x1 = -1
x(s1, s2, rank, n) = x1
Next
Next
sum1 = 0
For s2 = 1 To 10
sum1 = sum1 + x(s1, s2, 1, n) - x(s1, s2, 2, n) - x(s1, s2, 3, n)
Next
If sum1 = 0 Then t1 = 1000
t1 = t1 + 1
Loop
h = 0.001
de = 0
For s2 = 1 To 9
c1 = c(s1, s2) + x(s1, s2, 1, n) * h
x1 = y1(s1, s2) + x(s1, s2, 2, n) * h
x2 = y2(s1, s2) + x(s1, s2, 3, n) * h
u1 = u(s1, s2, th1, th2, c1, x1, x2)
c1 = c(s1, s2 + 1) + x(s1, s2 + 1, 1, n) * h
x1 = y1(s1, s2 + 1) + x(s1, s2 + 1, 2, n) * h
x2 = y2(s1, s2 + 1) + x(s1, s2 + 1, 3, n) * h
u2 = u(s1, s2, th1, th2, c1, x1, x2)
If u2 > u1 Then de = de + 10
Next
If de < 5 Then t2 = 1000
t2 = t2 + 1
Loop
Next
Debug.Print s1
Next
For s1 = 1 To 10
For n = 1 To 10
u1 = 0
For s2 = 1 To 10
c1 = c(s1, s2) + x(s1, s2, 1, n) * h
x1 = y1(s1, s2) + x(s1, s2, 2, n) * h
x2 = y2(s1, s2) + x(s1, s2, 3, n) * h
u1 = u1 + u(s1, s2, th1, th2, c1, x1, x2)
Next
gu(s1, n) = u1
Debug.Print s1, n, u1
Next
Next
End Sub