主题：魔方阵
bluemelody
[专家分：0] 发布于 2005-12-27 13:59:00
请教一下：
编制一个Ｎ阶魔方阵的程序．魔方阵的元素为１～Ｎ＾２的自然数，方阵的每一行，每一列以及对角线的元素之和均相等．
沙发
一生所爱 [专家分：0] 发布于 2005-12-30 15:41:00
[em1]不好意思，我问VB写的，请楼猪自己转换成QB的语法。
Dim mf(), i As Integer, j As Integer
Dim n As Integer, k As Integer
Private Sub Command1_Click()
n = Val(InputBox("输入魔方阵的阶数：", "提示"))
ReDim mf(1 To n, 1 To n)
For i = 1 To n
For j = 1 To n
mf(i, j) = 0
Next j
Next i
j = Int(n / 2) + 1
mf(1, j) = 1
For k = 2 To n * n
i = i - 1
j = j + 1
If (i < 1 And j > n) Then
i = i + 2
j = j - 1
Else
If i < 1 Then i = n
If j > n Then j = 1
End If
If mf(i, j) = 0 Then
mf(i, j) = k
Else
i = i + 2
j = j - 1
mf(i, j) = k
End If
Next k
Print
Print
For i = 1 To n
For j = 1 To n
Print Tab(j * 5); mf(i, j);
Next j
Print
Next i
End Sub
板凳
moz [专家分：37620] 发布于 2006-01-04 13:56:00
楼上的试试 4方阵或6方阵看看会不会出错？
弄了好多天，终于做出个程序来，只是边长越大，速度越慢。
declare sub swaps (z$, x&, y&)
declare function suns$ (a$)
declare function daos$ (a$)
declare function nextpl$ (a$)
declare function checkpl% ()
declare sub prints ()
deflng a-z
dim shared n, nn, sumn, s$
cls
input "n=", n
cls
nn = n * n
sumn = (1 + nn) * nn \ 2 \ n
dim shared s$(n), ss$(n)
for i = 1 to nn
s$ = s$ + chr$(i)
next
do until checkpl
mid$(s$, n) = daos$(mid$(s$, n))
s$ = nextpl$(s$)
'prints
loop
prints
end
function checkpl
for i = 1 to nn step n
sum1 = 0
for j = i to i + n - 1
sum1 = sum1 + asc(mid$(s$, j, 1))
next
j = j - 1
if sum1 > sumn then
mid$(s$, j) = daos$(mid$(s$, j))
s$ = nextpl$(s$)
i = i - n
elseif sum1 < sumn then
ee$ = chr$(asc(mid$(s$, j, 1)) + sumn - sum1)
eel = instr(j + 1, s$, ee$)
if eel > 0 then
swaps s$, eel, j
mid$(s$, j + 1) = suns$(mid$(s$, j + 1))
else
mid$(s$, j) = daos$(mid$(s$, j))
s$ = nextpl$(s$)
end if
i = i - n
end if
'prints
next
ik = 0
for q = n to 1 step -1
for i = ik to q ^ (n - 1) - 1
k = i
sum1 = asc(mid$(s$, q, 1))
for j = 2 to n
sum1 = sum1 + asc(mid$(s$, j * n - n + k mod q + 1, 1))
k = k \ q
next
if sum1 = sumn then
zi$ = zi$ + left$(str$(i) + space$(10), 10)
k = i
for j = 2 to n
swaps s$, j * n - n + k mod q + 1, j * n - n + q
k = k \ q
next
exit for
end if
next
if sum1 <> sumn then
if len(zi$) < 10 then exit for
q = q + 1
k = val(right$(zi$, 10))
ik = k + 1
zi$ = left$(zi$, len(zi$) - 10)
for j = 2 to n
swaps s$, j * n - n + k mod q + 1, j * n - n + q
k = k \ q
next
q = q + 1
else
ik = 0
end if
next
spl$ = ""
for i = 1 to n
spl$ = chr$(i) + spl$
next
zpl$ = spl$
do
sum1 = 0
sum2 = 0
z$ = ""
for i = 1 to n
z$ = z$ + mid$(s$, (asc(mid$(spl$, i, 1)) - 1) * n + 1, n)
sum1 = sum1 + asc(mid$(z$, (i - 1) * n + i, 1))
sum2 = sum2 + asc(mid$(z$, i * n - i + 1, 1))
next
if sum1 = sumn and sum2 = sumn then
s$ = z$
checkpl = -1
exit do
end if
spl$ = nextpl$(spl$)
loop until spl$ = zpl$
end function
function daos$ (a$)
for i = 2 to len(a$)
b$ = mid$(a$, i, 1)
for j = 1 to i - 1
if b$ > mid$(a$, j, 1) then
mid$(a$, j, i - j + 1) = b$ + mid$(a$, j, i - j)
exit for
end if
next j, i
daos$ = a$
end function
defsng a-z
function nextpl$ (a$)
l = len(a$)
for e = (l - 1) to 1 step -1
if mid$(a$, e, 1) < mid$(a$, e + 1, 1) then exit for
next
if e > 0 then
for i = l to (e + 1) step -1
if mid$(a$, i, 1) > mid$(a$, e, 1) then exit for
next
b$ = mid$(a$, i, 1)
mid$(a$, i, 1) = mid$(a$, e, 1)
mid$(a$, e, 1) = b$
end if
for i = (e + 1) to (l + e + 1) \ 2
j = l + e + 1 - i
b$ = mid$(a$, i, 1)
mid$(a$, i, 1) = mid$(a$, j, 1)
mid$(a$, j, 1) = b$
next
nextpl$ = a$
end function
deflng a-z
sub prints
locate 1, 1
for i = 1 to nn
print using "####"; asc(mid$(s$, i, 1));
if i mod n = 0 then print
next
locate 15, 1
for i = 1 to nn
print asc(mid$(s$, i, 1));
next
end sub
function suns$ (a$)
for i = 2 to len(a$)
b$ = mid$(a$, i, 1)
for j = 1 to i - 1
if b$ < mid$(a$, j, 1) then
mid$(a$, j, i - j + 1) = b$ + mid$(a$, j, i - j)
exit for
end if
next j, i
suns$ = a$
end function
sub swaps (z$, x, y)
z1$ = mid$(z$, x, 1)
mid$(z$, x, 1) = mid$(z$, y, 1)
mid$(z$, y, 1) = z1$
end sub
您所在位置：