NPSC補完計劃

登入註冊帳號.

請輸入帳號, 密碼以及預計登入時間
進階搜尋  

最新消息:

歡迎光臨NPSC補完計劃

+ NPSC補完計劃 » NPSC國中組 » NPSC2001國中組決賽
 [VB] NPSC 2001 決賽 pB 描繪輪廓

作者 主題: [VB] NPSC 2001 決賽 pB 描繪輪廓  (閱讀 1140 次)

lini

  • 高級會員
  • ****
  • 文章數: 101
    • 檢視個人資料
[VB] NPSC 2001 決賽 pB 描繪輪廓
« 於: 十一月 29, 2009, 07:26:49 pm »

解題思考:考慮所有的情形, 簡化的點必為在任一方形 上邊 及 右邊

擔心時間會爆...   以下可能不是最佳解

代碼: [選擇]
Sub main()
    Open "city.in" For Input As #1
    Open "city.out" For Output As #2
    Do
        e2do = False: ReDim a(10000, 2): ct = 1
        a(0, 0) = 0: a(0, 1) = 0: a(0, 2) = 10000
        Do
            Input #1, vl
            If vl = -1 Then Exit Do
            If vl = 0 Then e2do = True: Exit Do
            Input #1, vh, vr
            a(ct, 0) = vl
            a(ct, 1) = vh
            a(ct, 2) = vr
            ct = ct + 1
        Loop
        ReDim pt(10000, 1): ptct = 0
        For i = 1 To ct - 1
            c = False
            For j = 0 To ct - 1
                If a(i, 0) > a(j, 0) And a(i, 0) <= a(j, 2) And a(j, 1) >= a(i, 1) Then c = True: Exit For
            Next
            If c = False Then
                pt(ptct, 0) = a(i, 0)
                pt(ptct, 1) = a(i, 1)
                ptct = ptct + 1
            End If
            For k = 0 To ct - 1
                If a(i, 2) >= a(k, 0) And a(i, 2) < a(k, 2) And a(k, 1) < a(i, 1) Then
                    c2 = False
                    For l = 0 To ct - 1
                        If a(i, 2) >= a(l, 0) And a(i, 2) < a(l, 2) And a(l, 1) > a(k, 1) Then c2 = True: Exit For
                    Next
                    If c2 = False Then
                        pt(ptct, 0) = a(i, 2)
                        pt(ptct, 1) = a(k, 1)
                        ptct = ptct + 1
                    End If
                End If
            Next
        Next
        For m = ptct - 2 To 0 Step -1
            For n = 0 To m
                If pt(m, 0) > pt(m + 1, 0) Then
                    t1 = pt(m, 0)
                    t2 = pt(m, 1)
                    pt(m, 0) = pt(m + 1, 0)
                    pt(m, 1) = pt(m + 1, 1)
                    pt(m + 1, 0) = t1
                    pt(m + 1, 1) = t2
                End If
            Next
        Next
        f = ""
        For o = 0 To ptct - 1
            f = f & pt(o, 0) & " " & pt(o, 1) & " "
        Next
        Print #2, Trim(f)
        If e2do = True Then Exit Do
    Loop
    Close
End Sub
記錄
+ NPSC補完計劃 » NPSC國中組 » NPSC2001國中組決賽
 [VB] NPSC 2001 決賽 pB 描繪輪廓