' Generates Bimagic Squares of order 8, Magic Sum 260, Gaston Tarry
' Based on Sudoku Comparable Lines
' Tested with Office 2007 under Windows 7
Sub CnstrSqrs04()
Dim A1(64), B1(64), C1(8), C2(64), s8(32)
y = MsgBox("Blocked", vbCritical, "CnstrSqrs04")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
Sheets("Klad1").Select
For j1 = 2 To 49
a = Sheets("Lines8").Cells(j1, 24).Value
b = Sheets("Lines8").Cells(j1, 25).Value
c = Sheets("Lines8").Cells(j1, 26).Value
d = Sheets("Lines8").Cells(j1, 27).Value
For j2 = 2 To 49
p = Sheets("Lines8").Cells(j2, 10).Value
q = Sheets("Lines8").Cells(j2, 11).Value
r = Sheets("Lines8").Cells(j2, 12).Value
s = Sheets("Lines8").Cells(j2, 13).Value
If r * (a - b) <> c * (p - q) Then GoTo 20
GoSub 100 'Matrix A1
GoSub 200 'Matrix B1
For i1 = 1 To 64 'Resulting Square C2
' C2(i1) = 8 * (B1(i1) - 1) + A1(i1)
C2(i1) = 8 * (A1(i1) - 1) + B1(i1)
Next i1
GoSub 300: If fl1 = 0 Then GoTo 20 'Check Identical Numbers
GoSub 400: If fl1 = 0 Then GoTo 20 'Check Magic Sum
GoSub 500: If fl1 = 0 Then GoTo 20 'Check Bimagic Sum
GoSub 600: If fl1 = 0 Then GoTo 20 'Check Trimagic Sum (Main Diagonals)
' n9 = n9 + 1: GoSub 1000 'Print first lines (Test)
n9 = n9 + 1: GoSub 2650 'Print results (Squares)
20 Next j2
10 Next j1
End
' Matrix A1
100 fl1 = 1
A1(1) = a: A1(2) = b - c: A1(3) = b + d: A1(4) = a + c + d:
A1(5) = b: A1(6) = a + c: A1(7) = a + d: A1(8) = b - c + d:
A1(9) = b: A1(10) = a + c: A1(11) = a + d: A1(12) = b - c + d:
A1(13) = a: A1(14) = b - c: A1(15) = b + d: A1(16) = a + c + d:
A1(17) = a + c + d: A1(18) = b + d: A1(19) = b - c: A1(20) = a:
A1(21) = b - c + d: A1(22) = a + d: A1(23) = a + c: A1(24) = b:
A1(25) = b - c + d: A1(26) = a + d: A1(27) = a + c: A1(28) = b:
A1(29) = a + c + d: A1(30) = b + d: A1(31) = b - c: A1(32) = a:
A1(33) = a + d: A1(34) = b - c + d: A1(35) = b: A1(36) = a + c:
A1(37) = b + d: A1(38) = a + c + d: A1(39) = a: A1(40) = b - c:
A1(41) = b + d: A1(42) = a + c + d: A1(43) = a: A1(44) = b - c:
A1(45) = a + d: A1(46) = b - c + d: A1(47) = b: A1(48) = a + c:
A1(49) = a + c: A1(50) = b: A1(51) = b - c + d: A1(52) = a + d:
A1(53) = b - c: A1(54) = a: A1(55) = a + c + d: A1(56) = b + d:
A1(57) = b - c: A1(58) = a: A1(59) = a + c + d: A1(60) = b + d:
A1(61) = a + c: A1(62) = b: A1(63) = b - c + d: A1(64) = a + d:
i3 = 0
For i1 = 1 To 8
For i2 = 1 To 8
i3 = (i1 - 1) * 8 + i2
If A1(i3) < 1 Or A1(i3) > 8 Then fl1 = 0: Return
C1(i2) = A1(i3)
Next i2
GoSub 110: If fl1 = 0 Then Return 'Check Line
Next i1
Return
' Matrix B1
200 fl1 = 1
B1(1) = p + r: B1(2) = q - r + s: B1(3) = p: B1(4) = q + s:
B1(5) = p + r + s: B1(6) = q - r: B1(7) = p + s: B1(8) = q:
B1(9) = p: B1(10) = q + s: B1(11) = p + r: B1(12) = q - r + s:
B1(13) = p + s: B1(14) = q: B1(15) = p + r + s: B1(16) = q - r:
B1(17) = p + r + s: B1(18) = q - r: B1(19) = p + s: B1(20) = q:
B1(21) = p + r: B1(22) = q - r + s: B1(23) = p: B1(24) = q + s:
B1(25) = p + s: B1(26) = q: B1(27) = p + r + s: B1(28) = q - r:
B1(29) = p: B1(30) = q + s: B1(31) = p + r: B1(32) = q - r + s:
B1(33) = q - r: B1(34) = p + r + s: B1(35) = q: B1(36) = p + s:
B1(37) = q - r + s: B1(38) = p + r: B1(39) = q + s: B1(40) = p:
B1(41) = q: B1(42) = p + s: B1(43) = q - r: B1(44) = p + r + s:
B1(45) = q + s: B1(46) = p: B1(47) = q - r + s: B1(48) = p + r:
B1(49) = q - r + s: B1(50) = p + r: B1(51) = q + s: B1(52) = p:
B1(53) = q - r: B1(54) = p + r + s: B1(55) = q: B1(56) = p + s:
B1(57) = q + s: B1(58) = p: B1(59) = q - r + s: B1(60) = p + r:
B1(61) = q: B1(62) = p + s: B1(63) = q - r: B1(64) = p + r + s:
i3 = 0
For i1 = 1 To 8
For i2 = 1 To 8
i3 = (i1 - 1) * 8 + i2
If B1(i3) < 1 Or B1(i3) > 8 Then fl1 = 0: Return
C1(i2) = B1(i3)
Next i2
GoSub 110: If fl1 = 0 Then Return 'Check Line
Next i1
Return
' Check Identical Numbers (lines i1 = 1 ... 8)
110
For j10 = 1 To 8
c20 = C1(j10)
For j20 = (1 + j10) To 8
If c20 = C1(j20) Then fl1 = 0: Return
Next j20
Next j10
Return
' Check Identical Numbers
300 fl1 = 1
For j10 = 1 To 64
c20 = C2(j10)
For j20 = (1 + j10) To 64
If c20 = C2(j20) Then fl1 = 0: Return
Next j20
Next j10
Return
' Check Magic Sum
400 fl1 = 1
' Rows
s8(1) = C2(1) + C2(2) + C2(3) + C2(4) + C2(5) + C2(6) + C2(7) + C2(8)
s8(2) = C2(9) + C2(10) + C2(11) + C2(12) + C2(13) + C2(14) + C2(15) + C2(16)
s8(3) = C2(17) + C2(18) + C2(19) + C2(20) + C2(21) + C2(22) + C2(23) + C2(24)
s8(4) = C2(25) + C2(26) + C2(27) + C2(28) + C2(29) + C2(30) + C2(31) + C2(32)
s8(5) = C2(33) + C2(34) + C2(35) + C2(36) + C2(37) + C2(38) + C2(39) + C2(40)
s8(6) = C2(41) + C2(42) + C2(43) + C2(44) + C2(45) + C2(46) + C2(47) + C2(48)
s8(7) = C2(49) + C2(50) + C2(51) + C2(52) + C2(53) + C2(54) + C2(55) + C2(56)
s8(8) = C2(57) + C2(58) + C2(59) + C2(60) + C2(61) + C2(62) + C2(63) + C2(64)
' Columns
s8(9) = C2(1) + C2(9) + C2(17) + C2(25) + C2(33) + C2(41) + C2(49) + C2(57)
s8(10) = C2(2) + C2(10) + C2(18) + C2(26) + C2(34) + C2(42) + C2(50) + C2(58)
s8(11) = C2(3) + C2(11) + C2(19) + C2(27) + C2(35) + C2(43) + C2(51) + C2(59)
s8(12) = C2(4) + C2(12) + C2(20) + C2(28) + C2(36) + C2(44) + C2(52) + C2(60)
s8(13) = C2(5) + C2(13) + C2(21) + C2(29) + C2(37) + C2(45) + C2(53) + C2(61)
s8(14) = C2(6) + C2(14) + C2(22) + C2(30) + C2(38) + C2(46) + C2(54) + C2(62)
s8(15) = C2(7) + C2(15) + C2(23) + C2(31) + C2(39) + C2(47) + C2(55) + C2(63)
s8(16) = C2(8) + C2(16) + C2(24) + C2(32) + C2(40) + C2(48) + C2(56) + C2(64)
' Pan Diagonals
s8(17) = C2(1) + C2(10) + C2(19) + C2(28) + C2(37) + C2(46) + C2(55) + C2(64) 'Main
s8(18) = C2(2) + C2(11) + C2(20) + C2(29) + C2(38) + C2(47) + C2(56) + C2(57)
s8(19) = C2(3) + C2(12) + C2(21) + C2(30) + C2(39) + C2(48) + C2(49) + C2(58)
s8(20) = C2(4) + C2(13) + C2(22) + C2(31) + C2(40) + C2(41) + C2(50) + C2(59)
s8(21) = C2(5) + C2(14) + C2(23) + C2(32) + C2(33) + C2(42) + C2(51) + C2(60) 'Semi
s8(22) = C2(6) + C2(15) + C2(24) + C2(25) + C2(34) + C2(43) + C2(52) + C2(61)
s8(23) = C2(7) + C2(16) + C2(17) + C2(26) + C2(35) + C2(44) + C2(53) + C2(62)
s8(24) = C2(8) + C2(9) + C2(18) + C2(27) + C2(36) + C2(45) + C2(54) + C2(63)
s8(25) = C2(8) + C2(15) + C2(22) + C2(29) + C2(36) + C2(43) + C2(50) + C2(57) 'Main
s8(26) = C2(1) + C2(16) + C2(23) + C2(30) + C2(37) + C2(44) + C2(51) + C2(58)
s8(27) = C2(2) + C2(9) + C2(24) + C2(31) + C2(38) + C2(45) + C2(52) + C2(59)
s8(28) = C2(3) + C2(10) + C2(17) + C2(32) + C2(39) + C2(46) + C2(53) + C2(60)
s8(29) = C2(4) + C2(11) + C2(18) + C2(25) + C2(40) + C2(47) + C2(54) + C2(61) 'Semi
s8(30) = C2(5) + C2(12) + C2(19) + C2(26) + C2(33) + C2(48) + C2(55) + C2(62)
s8(31) = C2(6) + C2(13) + C2(20) + C2(27) + C2(34) + C2(41) + C2(56) + C2(63)
s8(32) = C2(7) + C2(14) + C2(21) + C2(28) + C2(35) + C2(42) + C2(49) + C2(64)
For i1 = 1 To 32
If s8(i1) <> 260 Then fl1 = 0: Return
Next i1
Return
' Check Bimagic Sum
500 fl1 = 1
' Rows
s8(1) = C2(1) ^ 2 + C2(2) ^ 2 + C2(3) ^ 2 + C2(4) ^ 2 + C2(5) ^ 2 + C2(6) ^ 2 + C2(7) ^ 2 + C2(8) ^ 2
s8(2) = C2(9) ^ 2 + C2(10) ^ 2 + C2(11) ^ 2 + C2(12) ^ 2 + C2(13) ^ 2 + C2(14) ^ 2 + C2(15) ^ 2 + C2(16) ^ 2
s8(3) = C2(17) ^ 2 + C2(18) ^ 2 + C2(19) ^ 2 + C2(20) ^ 2 + C2(21) ^ 2 + C2(22) ^ 2 + C2(23) ^ 2 + C2(24) ^ 2
s8(4) = C2(25) ^ 2 + C2(26) ^ 2 + C2(27) ^ 2 + C2(28) ^ 2 + C2(29) ^ 2 + C2(30) ^ 2 + C2(31) ^ 2 + C2(32) ^ 2
s8(5) = C2(33) ^ 2 + C2(34) ^ 2 + C2(35) ^ 2 + C2(36) ^ 2 + C2(37) ^ 2 + C2(38) ^ 2 + C2(39) ^ 2 + C2(40) ^ 2
s8(6) = C2(41) ^ 2 + C2(42) ^ 2 + C2(43) ^ 2 + C2(44) ^ 2 + C2(45) ^ 2 + C2(46) ^ 2 + C2(47) ^ 2 + C2(48) ^ 2
s8(7) = C2(49) ^ 2 + C2(50) ^ 2 + C2(51) ^ 2 + C2(52) ^ 2 + C2(53) ^ 2 + C2(54) ^ 2 + C2(55) ^ 2 + C2(56) ^ 2
s8(8) = C2(57) ^ 2 + C2(58) ^ 2 + C2(59) ^ 2 + C2(60) ^ 2 + C2(61) ^ 2 + C2(62) ^ 2 + C2(63) ^ 2 + C2(64) ^ 2
' Columns
s8(9) = C2(1) ^ 2 + C2(9) ^ 2 + C2(17) ^ 2 + C2(25) ^ 2 + C2(33) ^ 2 + C2(41) ^ 2 + C2(49) ^ 2 + C2(57) ^ 2
s8(10) = C2(2) ^ 2 + C2(10) ^ 2 + C2(18) ^ 2 + C2(26) ^ 2 + C2(34) ^ 2 + C2(42) ^ 2 + C2(50) ^ 2 + C2(58) ^ 2
s8(11) = C2(3) ^ 2 + C2(11) ^ 2 + C2(19) ^ 2 + C2(27) ^ 2 + C2(35) ^ 2 + C2(43) ^ 2 + C2(51) ^ 2 + C2(59) ^ 2
s8(12) = C2(4) ^ 2 + C2(12) ^ 2 + C2(20) ^ 2 + C2(28) ^ 2 + C2(36) ^ 2 + C2(44) ^ 2 + C2(52) ^ 2 + C2(60) ^ 2
s8(13) = C2(5) ^ 2 + C2(13) ^ 2 + C2(21) ^ 2 + C2(29) ^ 2 + C2(37) ^ 2 + C2(45) ^ 2 + C2(53) ^ 2 + C2(61) ^ 2
s8(14) = C2(6) ^ 2 + C2(14) ^ 2 + C2(22) ^ 2 + C2(30) ^ 2 + C2(38) ^ 2 + C2(46) ^ 2 + C2(54) ^ 2 + C2(62) ^ 2
s8(15) = C2(7) ^ 2 + C2(15) ^ 2 + C2(23) ^ 2 + C2(31) ^ 2 + C2(39) ^ 2 + C2(47) ^ 2 + C2(55) ^ 2 + C2(63) ^ 2
s8(16) = C2(8) ^ 2 + C2(16) ^ 2 + C2(24) ^ 2 + C2(32) ^ 2 + C2(40) ^ 2 + C2(48) ^ 2 + C2(56) ^ 2 + C2(64) ^ 2
' Diagonals
s8(17) = C2(1) ^ 2 + C2(10) ^ 2 + C2(19) ^ 2 + C2(28) ^ 2 + C2(37) ^ 2 + C2(46) ^ 2 + C2(55) ^ 2 + C2(64) ^ 2 'Main
s8(18) = C2(8) ^ 2 + C2(15) ^ 2 + C2(22) ^ 2 + C2(29) ^ 2 + C2(36) ^ 2 + C2(43) ^ 2 + C2(50) ^ 2 + C2(57) ^ 2 'Main
s8(19) = C2(5) ^ 2 + C2(14) ^ 2 + C2(23) ^ 2 + C2(32) ^ 2 + C2(33) ^ 2 + C2(42) ^ 2 + C2(51) ^ 2 + C2(60) ^ 2 'Semi
s8(20) = C2(4) ^ 2 + C2(11) ^ 2 + C2(18) ^ 2 + C2(25) ^ 2 + C2(40) ^ 2 + C2(47) ^ 2 + C2(54) ^ 2 + C2(61) ^ 2 'Semi
For i1 = 1 To 18
If s8(i1) <> 11180 Then fl1 = 0: Return
Next i1
Return
' Check Trimagic Sum (Main Diagonals)
600 fl1 = 1
s8(1) = C2(1) ^ 3 + C2(10) ^ 3 + C2(19) ^ 3 + C2(28) ^ 3 + C2(37) ^ 3 + C2(46) ^ 3 + C2(55) ^ 3 + C2(64) ^ 3 'Main
s8(2) = C2(8) ^ 3 + C2(15) ^ 3 + C2(22) ^ 3 + C2(29) ^ 3 + C2(36) ^ 3 + C2(43) ^ 3 + C2(50) ^ 3 + C2(57) ^ 3 'Main
s8(3) = C2(5) ^ 3 + C2(14) ^ 3 + C2(23) ^ 3 + C2(32) ^ 3 + C2(33) ^ 3 + C2(42) ^ 3 + C2(51) ^ 3 + C2(60) ^ 3 'Semi
s8(4) = C2(4) ^ 3 + C2(11) ^ 3 + C2(18) ^ 3 + C2(25) ^ 3 + C2(40) ^ 3 + C2(47) ^ 3 + C2(54) ^ 3 + C2(61) ^ 3 'Semi
For i1 = 1 To 2
If s8(i1) <> 540800 Then fl1 = 0: Return
Next i1
Return
' Print Squares
700
Return
' Print Lines
1000 Cells(n9, 28).Select
For i1 = 1 To 8
Cells(n9, i1).Value = a(i1)
Cells(n9, i1 + 9).Value = b(i1)
Cells(n9, i1 + 18).Value = C2(i1)
Next i1
Cells(n9, 27).Value = j1
Cells(n9, 28).Value = j2
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 9: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 9
End If
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(n9)
i3 = 0
For i1 = 1 To 8
For i2 = 1 To 8
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = C2(i3)
Next i2
Next i1
Return
End Sub
