2016年8月10日 星期三

滾球遊戲(VB版參考解)



改版後範例輸入
2
3 1 1
4 0 0
範例輸出
1 9
5 5
參考程式碼
    Const Maxn As Integer = 500 '盤面最大 500x500
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        FileOpen(1, "in1.txt", OpenMode.Input)
        ' FileOpen(2,"in2.txt",OpenMode.Input)
        FileOpen(3, "out.txt", OpenMode.Output)
        For fn = 1 To 1  '本題練習只讀一個檔
            If fn = 2 Then PrintLine(3)
            Dim t As Short = LineInput(fn) '以下 t 行,每行3個數字
            For k = 1 To t
                Dim nrc() = LineInput(fn).Split(" ")
                n = nrc(0) : n2 = n * n : n1 = n - 1
                Dim r As Integer = nrc(1), c As Integer = nrc(2)
                set0(gb) : setgb(r, c)  '設定遊戲盤 gb各格的數字
                printarr(gb)              ' 印出 遊戲盤 gb 各格的數字
                set0(bc)   '將 計數表 bc 清為0
                For r = 0 To n1
                    For c = 0 To n1
                        putball(r, c)  ' 每一格放一球,停止時在停止格球數加1
                    Next
                Next
                printarr(bc)  ' 印出 計數表 bc 各格的球數
            ' 還要再補一段 印出兩個數字
            Next k
        Next fn
        End
    End Sub
   
   Dim n, n1, n2 As Integer
    Dim gb(Maxn, Maxn) As Integer '遊戲盤
    Dim bc(Maxn, Maxn) As Integer '每格的球數
  
    Sub setgb(ByVal r, ByVal c) '從 (r,c)開始設定遊戲盤

        Dim t As Integer = 1, p As Integer
        Do While (t < n2)
            gb(r, c) = t
            p = (r * n + c + t) Mod n2
            t += 1
            r = p \ n : c = p Mod n
            Do While (gb(r, c) <> 0)
                p = (p + 1) Mod n2 '找 下一 空格; 
                r = p \ n : c = p Mod n
            Loop
        Loop
        gb(r, c) = t
    End Sub

    Dim dr() = {-1, 1, 0, 0}
    Dim dc() = {0, 0, -1, 1}
    Sub putball(ByVal r, ByVal c)   ' 從(r,c)格放一球,往低處走,停在(ur,uc)格,該格球數+1
        Dim m As Integer = gb(r, c)
        Dim ur = r, uc = c
        For d = 0 To 3
            Dim nr = r + dr(d), nc = c + dc(d)
            If (nr < 0 Or nr >= n Or nc < 0 Or nc >= n) Then Continue For
            If gb(nr, nc) < m Then
                ur = nr : uc = nc : m = gb(nr, nc)
            End If
        Next
        If (ur = r And uc = c) Then
            bc(r, c) += 1
        Else
            putball(ur, uc)
        End If
    End Sub
    Sub set0(ByVal x(,) As Integer) '將陣列內容清為0
        For i = 0 To n1
            For j = 0 To n1
                x(i, j) = 0
            Next
        Next
    End Sub
    Sub printarr(ByVal x(,) As Integer) '測試用,印陣列內容
        For i = 0 To n1
            For j = 0 To n1
                Print(3, x(i, j) & " ")
            Next
            PrintLine(3)
        Next

    End Sub

0 意見:

張貼留言