求解,算法题(1)

ydhj 2003-11-23 10:49:19
在平面上给定四个点P1(x1,y1),P2(x2,y2),P3(x3,y3),P4(x4,y4), 将4个点按照P1到P4顺序连线, 任意给定一个点P(x,y),用程序判断P点是否在P1, P2, P3, P4连线所围成的图形中.
注意:要考虑所有可能情况, 如图可围成不同区域

图片在这里:
http://auto.cnool.net/up/img/20031123104233.jpg
...全文
129 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
Random 2003-11-23
  • 打赏
  • 举报
回复
用API来实现于本题来说根本没有意义,不过是借助别人的算法得出结果,然后输出了这个结果而已!本题要求是寻求一种算法的过程,并不仅仅要求输出这个结果。

flyingscv(zlj)的所描述算法的确是一种好算法!理论上完全正确。可惜描述得不够详细,比如说如何判断射线与多边形有多少个交点?

下面是我的算法的实现,
Private PI As Double
Private Type CPoint
X As Double
Y As Double
End Type
Private P(4) As CPoint
Private m_PIndex As Long

'判断P0是否在P1,P2,P3所围成的三角形内
Private Function IncludeIt(P0 As CPoint, P1 As CPoint, P2 As CPoint, P3 As CPoint) As Boolean
Dim S As Double, S1 As Double, S2 As Double, S3 As Double
S = GetRecArea(P1, P2, P3)
S1 = GetRecArea(P0, P1, P2)
S2 = GetRecArea(P0, P1, P3)
S3 = GetRecArea(P0, P2, P3)
IncludeIt = (Abs((S1 + S2 + S3 - S)) < 0.0000001)
End Function

'取得三角形面积
Private Function GetRecArea(P1 As CPoint, P2 As CPoint, P3 As CPoint) As Double
Dim LX1 As Double, LY1 As Double
Dim LX2 As Double, LY2 As Double
Dim L1 As Double, L2 As Double, L3 As Double
Dim C As Double, C1 As Double, C2 As Double
Dim H As Double

LX1 = P2.X - P1.X
LY1 = P2.Y - P1.Y
L1 = Sqr(LX1 * LX1 + LY1 * LY1)
LX2 = P3.X - P1.X
LY2 = P3.Y - P1.Y
L2 = Sqr(LX2 * LX2 + LY2 * LY2)


If LX1 = 0 Then
If LY1 >= 0 Then C1 = PI * 0.5 Else C1 = PI * 1.5
ElseIf LX1 > 0 Then
If LY1 >= 0 Then C1 = Atn(LY1 / LX1) Else C1 = 2 * PI + Atn(LY1 / LX1)
Else
C1 = PI + Atn(LY1 / LX1)
End If

If LX2 = 0 Then
If LY2 >= 0 Then C2 = PI * 0.5 Else C2 = PI * 1.5
ElseIf LX2 > 0 Then
If LY2 >= 0 Then C2 = Atn(LY2 / LX2) Else C2 = 2 * PI + Atn(LY2 / LX2)
Else
C2 = PI + Atn(LY2 / LX2)
End If

C = Abs(C2 - C1)
If C > PI Then C = 2 * PI - C

H = Sin(C) * L1
GetRecArea = L2 * H / 2
End Function

Private Sub Form_Load()
AutoRedraw = True
PI = 4 * Atn(1)
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim blnIn1 As Boolean, blnIn2 As Boolean

If Button = 2 Then
m_PIndex = 0
Cls
Exit Sub
End If
If m_PIndex >= 4 Then
P(0).X = X
P(0).Y = Y

blnIn1 = IncludeIt(P(0), P(1), P(2), P(3))
blnIn2 = IncludeIt(P(0), P(1), P(4), P(3))

Print "P(" & CStr(X) & "," & CStr(Y) & ")" & IIf(blnIn1 Xor blnIn2, "", "不") & "在P1,P2,P3,P4所围成的区域中!"
Else
m_PIndex = m_PIndex + 1

P(m_PIndex).X = X
P(m_PIndex).Y = Y

CurrentX = X
CurrentY = Y
Print "P" & CStr(m_PIndex) & ":" & CStr(P(m_PIndex).X) & ";" & CStr(P(m_PIndex).Y)

If m_PIndex > 1 Then
Line (P(m_PIndex - 1).X, P(m_PIndex - 1).Y)-(P(m_PIndex).X, P(m_PIndex).Y)
If m_PIndex = 4 Then
Line (P(1).X, P(1).Y)-(P(m_PIndex).X, P(m_PIndex).Y)

Me.DrawStyle = 2
Line (P(1).X, P(1).Y)-(P(m_PIndex - 1).X, P(m_PIndex - 1).Y)
Me.DrawStyle = 0

CurrentX = 0
CurrentY = 0
Print "右键清除窗口"
End If
End If
End If
End Sub
northwolves 2003-11-23
  • 打赏
  • 举报
回复
可以API用某颜色填充该区域,再判断P(X,Y)之颜色是否一致。
flyingscv 2003-11-23
  • 打赏
  • 举报
回复
有一任意多边形的算法,意思大概是这样的
由p引出一条射线,如果与多边形有奇数个交点则说明在内部

有个API函数,大概是PtInregion,你看看有详细介绍
Random 2003-11-23
  • 打赏
  • 举报
回复
一种不太精确的算法(理论上正确,但在临界点可能出现偏差):
p1,p3,p2围成三角形a
p1,p3,p4围成三角形b
如果p在三角形a、b的其中一个三角形内并且不在另一个三角形内,则p在p1,p2,p3,p4所围成的区域内

判断p是否在三角形内a内的方法是:如果p与三角形a的任意两个顶点所围成的三个三角形的面积之和如果>三角形a的面积,则p在三角形a外面,否则p在三角形a内
同样可判断p是否在三角形b内。

计算三角形面积的方法就不详细说了,知道了三角形的三个边,总是能求出三角形面积的。
但是算法中一定要注意处理计算误差的情况,否则可能会出现很大的偏差!


7,768

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧