前面的下界问题解决了,但是现在又出现数据溢出,我检查了,定义没有问题!但是就是没法通过!导师这两天要看!急死了,先谢谢大家了!
Private Sub Command1_Click()
Dim a, b, ni, c, ok As Integer
Dim cc, result, sum, suml, bound, R As Single
Dim p(1 To 2, 1 To 2), p1(1 To 2, 1 To 2) As Single
Dim q(1 To 2) As Single
Dim s(1 To 2) As Single
Dim s1(1 To 2) As Single
Dim N, M, i, j As Integer
N = 2
M = 2
c = 1
result = 0 '赋初值
ni = 0
For i = 1 To N
For j = 1 To M
p(i, j) = InputBox("请输入数据")
Print p(i, j)
Next j
Next i
sum = 0 '赋初值
For j = 1 To M
For i = 1 To N
sum = sum + p(i, j)
Next i
Next j
If sum > 1 Then
Print "！"
c = 1
i = N
End If
c = 0
If c = 1 Then
bound = InputBox(":")
End If
For i = 1 To N
q(i) = 1 / N
Next i
For i = 1 To N
s(i) = q(i)
Next i
For j = 1 To M
s1(j) = 0 '赋初值
For i = 1 To N
s1(j) = s1(j) + s(i) * p1(i, j)
Next i
Next j
For j = 1 To M
For i = 1 To N
p(i, j) = s(i) * p1(i, j) / s1(j)
Next i
Next j
For i = 1 To N
q(i) = 0 '赋初值
For j = 1 To M
If p(i, j) > 0 Then
q(i) = q(i) + p1(i, j) * Log(p(i, j))
q(i) = Exp(q(i))
End If
Next j
Next i
suml = 0
For i = 1 To N
suml = suml + q(i)
Next i
For i = 1 To N
q(i) = q(i) / suml
ni = ni + 1
suml = result
Next i
For i = 1 To N
For j = 1 To M
If p(i, j) > 0 Then
result = result + s(i) * p1(i, j) * Log(p(i, j))
Else
result = 1
End If
Next j
If s(i) > 0 Then
result = result - s(i) * Log(s(i))
End If
Next i
If Abs(result - suml) < bound Then
ok = 1
End If
R = result / Log(2)
If ok = 0 Then
Print "：" & R
End If
End Sub
