先來科普一下什麼叫 n 階幻方。
看過射鵰英雄傳的人可能都記得,瑛姑閉關大半輩子,苦苦思索九宮格的問題,被黃蓉幾句口訣就破解了。瑛姑算的那個,就是 3 階幻方。
什麼是幻方:
幻方(Magic Square)是一種將數字安排在正方形格子中,使每行、列和對角線上的數字和都相等的方法。
行/列數為幾,就叫幾階幻方。
奇數幻方演算法:
奇數幻方和偶數幻方的演算法是完全不一樣的,所以我就分開來寫。本文講解奇數幻方。
其中最經典的填法是羅伯法。先把 1 放在第一行正中;按以下規律排列剩下的(n×n-1)個數,具體步驟為:
我大學專業課上講到幻方演算法的時候,老師的比喻更貼切:把平面想像成一個球體,不斷地向右上繞著球體填數,如果格子被佔位,則向下一格重新開始繞圈,直至填滿。
大家可以想像一下,就象下圖這樣:
把紙捲成球,按箭頭方向繞圈填數
程式碼:
理解了羅伯法以後,就可以用以下 VBA 來寫奇數幻方了:
Sub 奇數幻方填寫_陣列記錄()
n = Val(InputBox("請輸入[3-25]的奇數:", "n 階幻方的階數", 5)) "階數輸入框,預設輸入5
If n Mod 2 = 0 Or n < 3 Or n > 25 Then MsgBox "階數不能為 " & n: Exit Sub "如果階數為偶數,或超出定義範圍,則報錯並退出
[a1].CurrentRegion = ""
[a1].Resize(n, n).Select
"清空並選擇填寫區域
ReDim a(1 To n, 1 To n) "定義陣列
r = 1: c = (n + 1) / 2 "第一行中間填入1
a(r, c) = 1
For i = 2 To n ^ 2
If r = 1 And c = n Then "到第1行最末一列時
r = r + 1 "去下一行
ElseIf r = 1 Then "第1行,非最末一列時
r = n: c = c + 1 "到最末第n行,列+1
ElseIf c = n Then "到最末第n列時
r = r - 1: c = 1 "到第1列,行-1
ElseIf a(r - 1, c + 1) Then "右上格已填不為空時
Else "其他
r = r - 1: c = c + 1 "右上爬梯
End If
a(r, c) = i "順序填數
Next
Selection = a
End Sub
執行效果:
先來科普一下什麼叫 n 階幻方。
看過射鵰英雄傳的人可能都記得,瑛姑閉關大半輩子,苦苦思索九宮格的問題,被黃蓉幾句口訣就破解了。瑛姑算的那個,就是 3 階幻方。
什麼是幻方:
幻方(Magic Square)是一種將數字安排在正方形格子中,使每行、列和對角線上的數字和都相等的方法。
行/列數為幾,就叫幾階幻方。
奇數幻方演算法:
奇數幻方和偶數幻方的演算法是完全不一樣的,所以我就分開來寫。本文講解奇數幻方。
其中最經典的填法是羅伯法。先把 1 放在第一行正中;按以下規律排列剩下的(n×n-1)個數,具體步驟為:
每一個數放在前一個數的右上一格;如果這個數所要放的格已經超出了頂行那麼就把它放在底行,仍然要放在右一列;如果這個數所要放的格已經超出了最右列那麼就把它放在最左列,仍然要放在上一行;如果這個數所要放的格已經超出了頂行且超出了最右列,那麼就把它放在底行且最左列;如果這個數所要放的格已經有數填入,那麼就把它放在前一個數的下一行同一列的格內。我大學專業課上講到幻方演算法的時候,老師的比喻更貼切:把平面想像成一個球體,不斷地向右上繞著球體填數,如果格子被佔位,則向下一格重新開始繞圈,直至填滿。
大家可以想像一下,就象下圖這樣:
把紙捲成球,按箭頭方向繞圈填數
程式碼:
理解了羅伯法以後,就可以用以下 VBA 來寫奇數幻方了:
Sub 奇數幻方填寫_陣列記錄()
n = Val(InputBox("請輸入[3-25]的奇數:", "n 階幻方的階數", 5)) "階數輸入框,預設輸入5
If n Mod 2 = 0 Or n < 3 Or n > 25 Then MsgBox "階數不能為 " & n: Exit Sub "如果階數為偶數,或超出定義範圍,則報錯並退出
[a1].CurrentRegion = ""
[a1].Resize(n, n).Select
"清空並選擇填寫區域
ReDim a(1 To n, 1 To n) "定義陣列
r = 1: c = (n + 1) / 2 "第一行中間填入1
a(r, c) = 1
For i = 2 To n ^ 2
If r = 1 And c = n Then "到第1行最末一列時
r = r + 1 "去下一行
ElseIf r = 1 Then "第1行,非最末一列時
r = n: c = c + 1 "到最末第n行,列+1
ElseIf c = n Then "到最末第n列時
r = r - 1: c = 1 "到第1列,行-1
ElseIf a(r - 1, c + 1) Then "右上格已填不為空時
r = r + 1 "去下一行
Else "其他
r = r - 1: c = c + 1 "右上爬梯
End If
a(r, c) = i "順序填數
Next
Selection = a
End Sub
執行效果: