VB版论坛上有人问了类似的问题，利用以前积累下来的公式，居然穷举出来了
Option Explicit
Const MAXPOINT = 10
Private Type mypoint
x As Double
y As Double
End Type
Dim p(0 To MAXPOINT - 1) As mypoint
Dim mincx As Double
Dim mincy As Double
Dim minr As Double
Dim p1 As Long
Dim p2 As Long
Dim maxr As Double
Dim centerx As Long
Dim centery As Long
Private Sub Form_Load()
'黑色的比较清楚
Me.BackColor = vbBlack
Me.AutoRedraw = True
Me.Width = 800 * Screen.TwipsPerPixelX
Me.Height = 600 * Screen.TwipsPerPixelY
'所有图形都进行平移，多少无所谓，是一个数值就行
centerx = Me.ScaleWidth / 2 - 2000
centery = Me.ScaleHeight / 2 - 2000
Command1.Left = Me.ScaleWidth - Command1.Width
Command1.Top = Me.ScaleHeight - Command1.Height
End Sub
Private Function equ(ByVal a As Double, ByVal b As Double) As Boolean
If Abs(a - b) < 0.000001 Then
equ = True
Else
equ = False
End If
End Function
Private Function Is_Three_Point_In_A_Line(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal x3 As Double, ByVal y3 As Double) As Boolean
Dim a As Double, b As Double, e As Double
a = (x1 + x2) * (x1 - x2) + (y1 + y2) * (y1 - y2)
b = (x3 + x2) * (x3 - x2) + (y3 + y2) * (y3 - y2)
e = (x1 - x2) * (y3 - y2) - (x2 - x3) * (y2 - y1)
Is_Three_Point_In_A_Line = equ(e, 0)
End Function
Private Sub Calc_TPC(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal x3 As Double, ByVal y3 As Double, cx As Double, cy As Double, r As Double)
Dim a As Double, b As Double, e As Double
a = (x1 + x2) * (x1 - x2) + (y1 + y2) * (y1 - y2)
b = (x3 + x2) * (x3 - x2) + (y3 + y2) * (y3 - y2)
e = (x1 - x2) * (y3 - y2) - (x2 - x3) * (y2 - y1)
cx = (a * (y3 - y2) + b * (y2 - y1)) / (2 * e)
cy = (a * (x2 - x3) + b * (x1 - x2)) / (2 * e)
r = Sqr((x1 - cx) * (x1 - cx) + (y1 - cy) * (y1 - cy))
End Sub
Private Function incircle(ByVal cx As Double, ByVal cy As Double, ByVal r As Double, ByVal px As Double, ByVal py As Double) As Boolean
Dim l1 As Double, l2 As Double
Dim a As Double
l1 = px - cx
l2 = py - cy
a = (l1 ^ 2 + l2 ^ 2)
If a <= (r ^ 2) + 0.1 Then
incircle = True
Else
incircle = False
End If
End Function
Private Sub Command1_Click()
Me.FillStyle = vbTransparent
Me.FillColor = 0
Cls
Randomize Timer
'开始时将minr都置成很大，很重要
minr = 1E+90
maxr = 0
Dim i As Long, j As Long, k As Long
Dim l As Long
Dim xxx As Double
Dim cx As Double, cy As Double, r As Double
Dim count As Long
'先生成50个点
For i = 0 To MAXPOINT - 1
p(i).x = Rnd * 4000
p(i).y = Rnd * 4000
Next i
'先求 两个距离最远点，如果求出来，计算所形成的圆是否能够包含所有的点
'如果不能包含，就再用穷举的方法
For i = 0 To MAXPOINT - 1
For j = 0 To MAXPOINT - 1
'求两点的距离，找出最大的
xxx = Sqr((p(i).x - p(j).x) ^ 2 + (p(i).y - p(j).y) ^ 2)
cx = (p(i).x + p(j).x) / 2
cy = (p(i).y + p(j).y) / 2
r = Sqr((p(i).x - cx) ^ 2 + (p(i).y - cy) ^ 2)
If r > maxr Then
p1 = i
p2 = j
maxr = r
End If
Next j
Next i
'计算所有的点是否在圆内
cx = (p(p1).x + p(p2).x) / 2
cy = (p(p1).y + p(p2).y) / 2
r = Sqr((p(p1).x - cx) ^ 2 + (p(p1).y - cy) ^ 2)
count = 0
For l = 0 To MAXPOINT - 1
If incircle(cx, cy, r, p(l).x, p(l).y) Then
count = count + 1
End If
Next l
If count = MAXPOINT Then
'所有的点都在圆内
'画出最大的圆
cx = (p(p1).x + p(p2).x) / 2
cy = (p(p1).y + p(p2).y) / 2
r = Sqr((p(p1).x - cx) ^ 2 + (p(p1).y - cy) ^ 2)
Circle (cx + centerx, cy + centery), r, vbBlue
Else
'计算所有的圆
For i = 0 To MAXPOINT - 1
For j = 0 To MAXPOINT - 1
For k = 0 To MAXPOINT - 1
If Not Is_Three_Point_In_A_Line(p(i).x, p(i).y, p(j).x, p(j).y, p(k).x, p(k).y) Then
'三点可求圆
'求圆
Calc_TPC p(i).x, p(i).y, p(j).x, p(j).y, p(k).x, p(k).y, cx, cy, r
'计算所有的点是否在圆内
count = 0
For l = 0 To MAXPOINT - 1
If incircle(cx, cy, r, p(l).x, p(l).y) Then
count = count + 1
End If
Next l
If count = MAXPOINT Then
'所有的点都在圆内
If r < minr Then
mincx = cx
mincy = cy
minr = r
End If
End If
End If
Next k
Next j
Next i
'画出最小的圆
Circle (mincx + centerx, mincy + centery), minr, vbGreen
End If
'将50个点显示在屏幕上
Me.FillStyle = vbSolid
Me.FillColor = vbRed
For i = 0 To MAXPOINT - 1
Me.Circle (p(i).x + centerx, p(i).y + centery), 30, vbRed
Next i
End Sub
发表于 @ 2008年05月22日 19:25:00|评论(loading...)|编辑