【摁蛋?】凸包算法的实现
93°2010/02/27软件综合 IP:广东
老物了,想起以前跑图书馆的时候……整理下发出来



convexh.png
+500  科创币    phpskycn    2010/02/27 以前似乎发过了
来自:计算机科学 / 软件综合
5
已屏蔽 原因:{{ notice.reason }}已屏蔽
{{notice.noticeContent}}
~~空空如也
93° 作者
14年5个月前 IP:未同步
196286
凸包的算法

首先需要获得Y轴数值最大的点(对于计算机屏幕的坐标系),如果有同样大则取X轴最小的,记为zero。
然后以zero为原点,将所有其他点按极坐标从小到大排列。

使排列后极角度最小的2个点入栈,使用向量的叉积判断转向,先使下一个点入栈,依次判断下一个点的转向,如果是非左转就出栈。最后的栈就是凸包的顶点。

cx1.png

cx0.png

cx2.png

这就是著名的Graham scan算法。

算法实现

为了操作栈,我们需要使用.net的stack类,再自己编写一些函数。

NEXT_TO_TOP : 获得栈顶的下一个值。

代码:

Public Class StackClass

    Dim _stack As New Stack(Of Point)

    Public Function PUSH(ByVal item As Point) As Boolean
        _stack.Push(item)
        Return True
    End Function

    Public Function POP() As Boolean
        _stack.Pop()
        Return True
    End Function

    Public Function TOP() As Point
        Return _XXXXXXXXek
    End Function

    Public Function NEXT_TO_TOP() As Point
        Dim _tmp As Point
        Dim _result As Point
        _tmp = _stack.Pop()
        _result = _XXXXXXXXek
        _stack.Push(_tmp)
        Return _result
    End Function

    Public Function StackToArray() As Point()
        Return _XXXXXXXXArray
    End Function

End Class


下面是凸包类:

Public Class Convex
    Public Structure POINT_STR

        Dim p As Point
        Dim drg As Double

    End Structure


    Public Sub BubbleSort(ByVal array_in() As POINT_STR)
        Dim c As Long
        Dim i As Integer, temp As POINT_STR, w As Integer
        For c = 2 To array_in.Length
            For i = 0 To UBound(array_in) - 1
                If (array_in(i).drg > array_in(i + 1).drg) Then
                    temp = array_in(i)
                    array_in(i) = array_in(i + 1)
                    array_in(i + 1) = temp
                End If
            Next

        Next
    End Sub

    Public Function ConvexHull(ByVal input_point() As Point) As Point()
        Dim max As Integer = 0
        Dim _zero As Point
        Dim point_var(input_point.Length - 1) As POINT_STR
        Dim loopvar As Integer

        For Each item As Point In input_point
            If item.Y > max Then
                max = item.Y
                _zero = item
            End If
        Next


        Dim c As Integer = 0

        For Each item As Point In input_point

            If _zero.X = item.X And _zero.Y = item.Y Then
                point_var(c).drg = 9999
                point_var(c).p = _zero
            Else
                point_var(c).drg = GetDrg(_zero, item)
                point_var(c).p = item
            End If

            c += 1
        Next

        ReDim Preserve point_var(point_var.Length - 2)

        BubbleSort(point_var)

        Dim loli As New StackClass
        loli.PUSH(point_var(0).p)
        loli.PUSH(point_var(1).p)


        For loopvar = 2 To UBound(point_var)
            If Not CROSS_PRODUCK(XXXXXXXXT_TO_TOP, XXXXXXXP, point_var(loopvar).p) Then
                loli.POP()
            End If
            loli.PUSH(point_var(loopvar).p)
        Next
        Dim result() As Point
        result = XXXXXXXackToArray
        Return result
    End Function

    Public Function CROSS_PRODUCK(ByVal p0 As Point, ByVal p1 As Point, ByVal p2 As Point) As Boolean

        Dim _produck As Integer
        _produck = (p1.X - p0.X) * (p2.Y - p0.Y) - (p2.X - p0.X) * (p1.Y - p0.Y)

        If _produck <= 0 Then Return True Else
        Return False

    End Function


    Public Function GetDrg(ByVal p0 As Point, ByVal p1 As Point) As Double
        Dim _zero As Point
        _zero = New Point(Math.Abs(p1.X - p0.X), Math.Abs(p1.Y - p0.Y))
        Dim tmp As Double
        tmp = XXXXXXXan(_zero.Y / _zero.X) * (180 / Math.PI)
        If p1.X < p0.X Then tmp = 90 - tmp + 90
        Return tmp
    End Function
End Class


由于只是简单的实现,对特殊情况没有考虑,各位请自行修改。
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
ltl
14年5个月前 IP:未同步
196336
你不觉得你写长了吗???还不是一般的冗长……还有就是扫描法虽然是O(nlogn)的,但只在平面上成立,高维凸包还是要O(n^2)的步进法的……
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
93°作者
14年5个月前 IP:未同步
196337
2年前写的东西,就不要吐槽了 = =
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
boldness123
14年5个月前 IP:未同步
196964
Dim loli As New StackClass
        loli.PUSH(point_var(0).p)
[s:94] 哈 亮点
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
joyeep
14年5个月前 IP:未同步
198265

attachment icon AreaOfTrianglesF.rar 88.25KB RAR 24次下载

我以前做的一个求外包的程序,基于逻辑坐标,可是有些小问题,后来也没有去管,用的时候再去查BUG
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论

想参与大家的讨论?现在就 登录 或者 注册

所属专业
上级专业
同级专业
93°
学者 笔友
文章
651
回复
6032
学术分
30
2007/04/10注册,6年5个月前活动
暂无简介
主体类型:个人
所属领域:无
认证方式:邮箱
IP归属地:未同步
文件下载
加载中...
{{errorInfo}}
{{downloadWarning}}
你在 {{downloadTime}} 下载过当前文件。
文件名称:{{resource.defaultFile.name}}
下载次数:{{resource.hits}}
上传用户:{{uploader.username}}
所需积分:{{costScores}},{{holdScores}}下载当前附件免费{{description}}
积分不足,去充值
文件已丢失

当前账号的附件下载数量限制如下:
时段 个数
{{f.startingTime}}点 - {{f.endTime}}点 {{f.fileCount}}
视频暂不能访问,请登录试试
仅供内部学术交流或培训使用,请先保存到本地。本内容不代表科创观点,未经原作者同意,请勿转载。
音频暂不能访问,请登录试试
支持的图片格式:jpg, jpeg, png
插入公式
评论控制
加载中...
文号:{{pid}}
投诉或举报
加载中...
{{tip}}
请选择违规类型:
{{reason.type}}

空空如也

加载中...
详情
详情
推送到专栏从专栏移除
设为匿名取消匿名
查看作者
回复
只看作者
加入收藏取消收藏
收藏
取消收藏
折叠回复
置顶取消置顶
评学术分
鼓励
设为精选取消精选
管理提醒
编辑
通过审核
评论控制
退修或删除
历史版本
违规记录
投诉或举报
加入黑名单移除黑名单
查看IP
{{format('YYYY/MM/DD HH:mm:ss', toc)}}