Imports System.IO
Public Class Form1
'Imports System.Math
Function u(ByVal c1 As Single, ByVal l1 As Single, ByVal l2 As Single) As Single
Dim pp As Single
pp = 0
If l1 < 0 Then pp = 1
If l2 < 0 Then pp = 1
If c1 < 0 Then pp = 1
If l1 > 0.99 Then pp = 1
If l2 > 0.99 Then pp = 1
If pp > 0.5 Then c1 = 0.5
If pp > 0.5 Then l1 = 0.5
If pp > 0.5 Then l2 = 0.5
u = Math.Log(c1) + Math.Log(1 - l1) + Math.Log(1 - l2)
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim s As Single
Dim q As Single
Dim u1 As Single
Dim th1(10) As Single
Dim th2(10) As Single
Dim y1(10, 10) As Single
Dim y2(10, 10) As Single
Dim c(10, 10) As Single
Dim g(10, 2, 2, 2) As Single
Dim w(9, 2, 2, 2) As Single
Dim v(9, 2, 2, 2, 10) As Single
Dim gotoc(9, 2, 2, 2, 10) As Single
Dim goto1(9, 2, 2, 2, 10) As Single
Dim goto2(9, 2, 2, 2, 10) As Single
Dim gotoq(9, 2, 2, 2, 10) As Single
Dim endv(2, 2, 2) As Single
Dim endc(2, 2, 2) As Single
Dim end1(2, 2, 2) As Single
Dim end2(2, 2, 2) As Single
Dim endq(2, 2, 2) As Single
Dim tl As Single
Dim tk As Single
Dim tr As Single
Dim s1 As Single
Dim s2 As Single
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
Dim cp As Single
Dim yp1 As Single
Dim yp2 As Single
Dim l1 As Single
Dim l2 As Single
Dim h As Single
Dim qx As Single
Dim mx1 As Single
Dim mx2 As Single
Dim mx3 As Single
Dim vs As Single
Dim pp As Single
Dim v1 As Single
Dim nx1 As Single
Dim nx2 As Single
Dim nx3 As Single
Dim ep As Single
Dim t As Single
Dim z(10) As Single
Dim maxu As Single
Dim u2 As Single
For s = 1 To 10
th1(s) = 0.2 * s
th2(s) = 0.1 * s
Next
Dim sr2 As StreamReader
Dim sr1 As StreamReader
Dim src As StreamReader
Dim n As Single
Dim a(100) As Single
n = 1
src = New StreamReader("C:\datac.txt")
Do While Not src.EndOfStream
a(n) = src.ReadLine()
n = n + 1
Loop
src.Close()
s1 = 1
s2 = 1
For n = 1 To 100
c(s1, s2) = a(n)
s2 = s2 + 1
If s2 = 11 Then s1 = s1 + 1
If s2 = 11 Then s2 = 1
Next
n = 1
sr1 = New StreamReader("C:\data1.txt")
Do While Not sr1.EndOfStream
a(n) = sr1.ReadLine()
n = n + 1
Loop
sr1.Close()
s1 = 1
s2 = 1
For n = 1 To 100
y1(s1, s2) = a(n)
s2 = s2 + 1
If s2 = 11 Then s1 = s1 + 1
If s2 = 11 Then s2 = 1
Next
n = 1
sr2 = New StreamReader("C:\data2.txt")
Do While Not sr2.EndOfStream
a(n) = sr2.ReadLine()
n = n + 1
Loop
sr2.Close()
s1 = 1
s2 = 1
For n = 1 To 100
y2(s1, s2) = a(n)
s2 = s2 + 1
If s2 = 11 Then s1 = s1 + 1
If s2 = 11 Then s2 = 1
Next
For s2 = 1 To 10
h = 0.001
t = 0
Do Until t > 20
For s1 = 1 To 10
maxu = -999
For m1 = 1 To 10
For m2 = 1 To 10
cp = c(m1, m2)
yp1 = y1(m1, m2)
yp2 = y2(m1, m2)
l1 = yp1 / th1(s1)
l2 = yp2 / th2(s2)
u1 = u(cp, l1, l2)
If m2 = s2 Then u1 = -999
If u1 > maxu Then maxu = u1
Next
Next
z(s1) = maxu
Next
For s1 = 1 To 10
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
cp = c(s1, s2) + n3 * h
yp1 = y1(s1, s2) + n1 * h
yp2 = y2(s1, s2) + n2 * h
l1 = yp1 / th1(s1)
l2 = yp2 / th2(s2)
u1 = u(cp, l1, l2)
If z(s1) > u1 Then u1 = -999
g(s1, n1 + 1, n2 + 1, n3 + 1) = u1
Next
Next
Next
Next
For s1 = 1 To 10
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
pp = 0
For m1 = 1 To 10
For m2 = 1 To 10
cp = c(m1, m2)
yp1 = y1(m1, m2)
yp2 = y2(m1, m2)
l1 = yp1 / th1(m1)
l2 = yp2 / th2(m2)
u1 = u(cp, l1, l2)
cp = c(s1, s2) + n3 * h
yp1 = y1(s1, s2) + n1 * h
yp2 = y2(s1, s2) + n2 * h
l1 = yp1 / th1(m1)
l2 = yp2 / th2(m2)
u2 = u(cp, l1, l2)
If s2 = m2 Then u2 = -999
If u2 > u1 Then pp = 10
Next
Next
If pp > 5 Then g(s1, n1 + 1, n2 + 1, n3 + 1) = -999
Next
Next
Next
Next
For s1 = 1 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
cp = c(s1, s2) + n3 * h
yp1 = y1(s1, s2) + n1 * h
yp2 = y2(s1, s2) + n2 * h
l1 = yp1 / th1(s1 + 1)
l2 = yp2 / th2(s2)
w(s1, n1 + 1, n2 + 1, n3 + 1) = u(cp, l1, l2)
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
For q = -5 To 5
v(1, n1 + 1, n2 + 1, n3 + 1, q + 5) = -999
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
q = n2 + n1 - n3
v(1, n1 + 1, n2 + 1, n3 + 1, q + 5) = g(1, n1 + 1, n2 + 1, n3 + 1)
Next
Next
Next
For s1 = 2 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
For q = -5 To 5
qx = q - n1 - n2 + n3
pp = 0
If qx > 5 Then pp = 1
If qx < -5 Then pp = 1
If qx > 5 Then qx = 0
If qx < -5 Then qx = 0
vs = -999
For m1 = -1 To 1
For m2 = -1 To 1
For m3 = -1 To 1
v1 = g(s1, n1 + 1, n2 + 1, n3 + 1) + v(s1 - 1, m1 + 1, m2 + 1, m3 + 1, qx + 5)
If w(s1 - 1, m1 + 1, m2 + 1, m3 + 1) > g(s1, n1 + 1, n2 + 1, n3 + 1) Then v1 = -999
If v1 > vs Then mx1 = m1
If v1 > vs Then mx2 = m2
If v1 > vs Then mx3 = m3
If v1 > vs Then vs = v1
Next
Next
Next
If pp = 1 Then vs = -999
v(s1, n1 + 1, n2 + 1, n3 + 1, q + 5) = vs
gotoc(s1, n1 + 1, n2 + 1, n3 + 1, q + 5) = mx3
goto1(s1, n1 + 1, n2 + 1, n3 + 1, q + 5) = mx1
goto2(s1, n1 + 1, n2 + 1, n3 + 1, q + 5) = mx2
gotoq(s1, n1 + 1, n2 + 1, n3 + 1, q + 5) = qx
Next
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
qx = n3 - n1 - n2
vs = -999
For m1 = -1 To 1
For m2 = -1 To 1
For m3 = -1 To 1
v1 = g(10, n1 + 1, n2 + 1, n3 + 1) + v(9, m1 + 1, m2 + 1, m3 + 1, qx + 5)
If w(9, m1 + 1, m2 + 1, m3 + 1) > g(10, n1 + 1, n2 + 1, n3 + 1) Then v1 = -999
If v1 > vs Then mx1 = m1
If v1 > vs Then mx2 = m2
If v1 > vs Then mx3 = m3
If v1 > vs Then vs = v1
Next
Next
Next
endc(n1 + 1, n2 + 1, n3 + 1) = mx3
end1(n1 + 1, n2 + 1, n3 + 1) = mx1
end2(n1 + 1, n2 + 1, n3 + 1) = mx2
endq(n1 + 1, n2 + 1, n3 + 1) = qx
endv(n1 + 1, n2 + 1, n3 + 1) = vs
Next
Next
Next
vs = -999
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
If endv(n1 + 1, n2 + 1, n3 + 1) > vs Then nx1 = n1
If endv(n1 + 1, n2 + 1, n3 + 1) > vs Then nx2 = n2
If endv(n1 + 1, n2 + 1, n3 + 1) > vs Then nx3 = n3
If endv(n1 + 1, n2 + 1, n3 + 1) > vs Then vs = endv(n1 + 1, n2 + 1, n3 + 1)
Next
Next
Next
Dim opc(10) As Single
Dim op1(10) As Single
Dim opq(10) As Single
Dim op2(10) As Single
opc(10) = nx3
op1(10) = nx1
op2(10) = nx2
opc(9) = endc(op1(10) + 1, op2(10) + 1, opc(10) + 1)
op1(9) = end1(op1(10) + 1, op2(10) + 1, opc(10) + 1)
op2(9) = end2(op1(10) + 1, op2(10) + 1, opc(10) + 1)
opq(9) = endq(op1(10) + 1, op2(10) + 1, opc(10) + 1)
For j = 1 To 8
s1 = 9 - j
opc(s1) = gotoc(s1 + 1, op1(s1 + 1) + 1, op2(s1 + 1) + 1, opc(s1 + 1) + 1, opq(s1 + 1) + 5)
op1(s1) = goto1(s1 + 1, op1(s1 + 1) + 1, op2(s1 + 1) + 1, opc(s1 + 1) + 1, opq(s1 + 1) + 5)
op2(s1) = goto2(s1 + 1, op1(s1 + 1) + 1, op2(s1 + 1) + 1, opc(s1 + 1) + 1, opq(s1 + 1) + 5)
opq(s1) = gotoq(s1 + 1, op1(s1 + 1) + 1, op2(s1 + 1) + 1, opc(s1 + 1) + 1, opq(s1 + 1) + 5)
Next
ep = 0
For s1 = 1 To 10
ep = ep + opc(s1) * opc(s1) + op1(s1) * op1(s1) + op2(s1) * op2(s1)
Next
If ep < 2 Then h = h / 2
If h < 0.0001 Then t = 1000
For s1 = 1 To 10
c(s1, s2) = c(s1, s2) + opc(s1) * h
y1(s1, s2) = y1(s1, s2) + op1(s1) * h
y2(s1, s2) = y2(s1, s2) + op2(s1) * h
Next
t = t + 1
Loop
Next
MsgBox(vs)
For s1 = 1 To 10
h = 0.001
t = 0
Do Until t > 20
For s2 = 1 To 10
maxu = -999
For m1 = 1 To 10
For m2 = 1 To 10
cp = c(m1, m2)
yp1 = y1(m1, m2)
yp2 = y2(m1, m2)
l1 = yp1 / th1(s1)
l2 = yp2 / th2(s2)
u1 = u(cp, l1, l2)
If m1 = s1 Then u1 = -999
If u1 > maxu Then maxu = u1
Next
Next
z(s2) = maxu
Next
For s2 = 1 To 10
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
cp = c(s1, s2) + n3 * h
yp1 = y1(s1, s2) + n1 * h
yp2 = y2(s1, s2) + n2 * h
l1 = yp1 / th1(s1)
l2 = yp2 / th2(s2)
u1 = u(cp, l1, l2)
If z(s2) > u1 Then u1 = -999
g(s2, n1 + 1, n2 + 1, n3 + 1) = u1
Next
Next
Next
Next
For s2 = 1 To 10
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
pp = 0
For m1 = 1 To 10
For m2 = 1 To 10
cp = c(m1, m2)
yp1 = y1(m1, m2)
yp2 = y2(m1, m2)
l1 = yp1 / th1(m1)
l2 = yp2 / th2(m2)
u1 = u(cp, l1, l2)
cp = c(s1, s2) + n3 * h
yp1 = y1(s1, s2) + n1 * h
yp2 = y2(s1, s2) + n2 * h
l1 = yp1 / th1(m1)
l2 = yp2 / th2(m2)
u2 = u(cp, l1, l2)
If s1 = m1 Then u2 = -999
If u2 > u1 Then pp = 10
Next
Next
If pp > 5 Then g(s2, n1 + 1, n2 + 1, n3 + 1) = -999
Next
Next
Next
Next
For s2 = 1 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
cp = c(s1, s2) + n3 * h
yp1 = y1(s1, s2) + n1 * h
yp2 = y2(s1, s2) + n2 * h
l1 = yp1 / th1(s1)
l2 = yp2 / th2(s2 + 1)
w(s2, n1 + 1, n2 + 1, n3 + 1) = u(cp, l1, l2)
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
For q = -5 To 5
v(1, n1 + 1, n2 + 1, n3 + 1, q + 5) = -999
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
q = n2 + n1 - n3
v(1, n1 + 1, n2 + 1, n3 + 1, q + 5) = g(1, n1 + 1, n2 + 1, n3 + 1)
Next
Next
Next
For s2 = 2 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
For q = -5 To 5
qx = q - n1 - n2 + n3
pp = 0
If qx > 5 Then pp = 1
If qx < -5 Then pp = 1
If qx > 5 Then qx = 0
If qx < -5 Then qx = 0
vs = -999
For m1 = -1 To 1
For m2 = -1 To 1
For m3 = -1 To 1
v1 = g(s2, n1 + 1, n2 + 1, n3 + 1) + v(s2 - 1, m1 + 1, m2 + 1, m3 + 1, qx + 5)
If w(s2 - 1, m1 + 1, m2 + 1, m3 + 1) > g(s2, n1 + 1, n2 + 1, n3 + 1) Then v1 = -999
If v1 > vs Then mx1 = m1
If v1 > vs Then mx2 = m2
If v1 > vs Then mx3 = m3
If v1 > vs Then vs = v1
Next
Next
Next
If pp = 1 Then vs = -999
v(s2, n1 + 1, n2 + 1, n3 + 1, q + 5) = vs
gotoc(s2, n1 + 1, n2 + 1, n3 + 1, q + 5) = mx3
goto1(s2, n1 + 1, n2 + 1, n3 + 1, q + 5) = mx1
goto2(s2, n1 + 1, n2 + 1, n3 + 1, q + 5) = mx2
gotoq(s2, n1 + 1, n2 + 1, n3 + 1, q + 5) = qx
Next
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
qx = n3 - n1 - n2
vs = -999
For m1 = -1 To 1
For m2 = -1 To 1
For m3 = -1 To 1
v1 = g(10, n1 + 1, n2 + 1, n3 + 1) + v(9, m1 + 1, m2 + 1, m3 + 1, qx + 5)
If w(9, m1 + 1, m2 + 1, m3 + 1) > g(10, n1 + 1, n2 + 1, n3 + 1) Then v1 = -999
If v1 > vs Then mx1 = m1
If v1 > vs Then mx2 = m2
If v1 > vs Then mx3 = m3
If v1 > vs Then vs = v1
Next
Next
Next
endc(n1 + 1, n2 + 1, n3 + 1) = mx3
end1(n1 + 1, n2 + 1, n3 + 1) = mx1
end2(n1 + 1, n2 + 1, n3 + 1) = mx2
endq(n1 + 1, n2 + 1, n3 + 1) = qx
endv(n1 + 1, n2 + 1, n3 + 1) = vs
Next
Next
Next
vs = -999
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
If endv(n1 + 1, n2 + 1, n3 + 1) > vs Then nx1 = n1
If endv(n1 + 1, n2 + 1, n3 + 1) > vs Then nx2 = n2
If endv(n1 + 1, n2 + 1, n3 + 1) > vs Then nx3 = n3
If endv(n1 + 1, n2 + 1, n3 + 1) > vs Then vs = endv(n1 + 1, n2 + 1, n3 + 1)
Next
Next
Next
Dim opc(10) As Single
Dim op1(10) As Single
Dim opq(10) As Single
Dim op2(10) As Single
opc(10) = nx3
op1(10) = nx1
op2(10) = nx2
opc(9) = endc(op1(10) + 1, op2(10) + 1, opc(10) + 1)
op1(9) = end1(op1(10) + 1, op2(10) + 1, opc(10) + 1)
op2(9) = end2(op1(10) + 1, op2(10) + 1, opc(10) + 1)
opq(9) = endq(op1(10) + 1, op2(10) + 1, opc(10) + 1)
For j = 1 To 8
s2 = 9 - j
opc(s2) = gotoc(s2 + 1, op1(s2 + 1) + 1, op2(s2 + 1) + 1, opc(s2 + 1) + 1, opq(s2 + 1) + 5)
op1(s2) = goto1(s2 + 1, op1(s2 + 1) + 1, op2(s2 + 1) + 1, opc(s2 + 1) + 1, opq(s2 + 1) + 5)
op2(s2) = goto2(s2 + 1, op1(s2 + 1) + 1, op2(s2 + 1) + 1, opc(s2 + 1) + 1, opq(s2 + 1) + 5)
opq(s2) = gotoq(s2 + 1, op1(s2 + 1) + 1, op2(s2 + 1) + 1, opc(s2 + 1) + 1, opq(s2 + 1) + 5)
Next
ep = 0
For s2 = 1 To 10
ep = ep + opc(s2) * opc(s2) + op1(s2) * op1(s2) + op2(s2) * op2(s2)
Next
If ep < 2 Then h = h / 2
If h < 0.0001 Then t = 1000
For s2 = 1 To 10
c(s1, s2) = c(s1, s2) + opc(s2) * h
y1(s1, s2) = y1(s1, s2) + op1(s2) * h
y2(s1, s2) = y2(s1, s2) + op2(s2) * h
Next
t = t + 1
Loop
Next
Dim don As Single
don = 0
For s1 = 1 To 10
For s2 = 1 To 10
cp = c(s1, s2)
l1 = y1(s1, s2) / th1(s1)
l2 = y2(s1, s2) / th2(s2)
don = don + u(cp, l1, l2)
Next
Next
Dim Writer1 As New IO.StreamWriter("C:\datac.txt")
For s1 = 1 To 10
For s2 = 1 To 10
Writer1.WriteLine(c(s1, s2))
Next
Next
Writer1.Close()
Dim Writer2 As New IO.StreamWriter("C:\data1.txt")
For s1 = 1 To 10
For s2 = 1 To 10
Writer2.WriteLine(y1(s1, s2))
Next
Next
Writer2.Close()
Dim Writer3 As New IO.StreamWriter("C:\data2.txt")
For s1 = 1 To 10
For s2 = 1 To 10
Writer3.WriteLine(y2(s1, s2))
Next
Next
Writer3.Close()
MsgBox(don)
End Sub
End Class
最終更新：2009年11月30日 08:05
