' Generates Bimagic Squares of order 8, Magic Sum 260, Aale de Winkel
' Tested with Office 2007 under Windows 7
Sub CnstrSqrs11a()
Dim a(64), b(64), c(64), d(64), E(64), F(64) 'Input
Dim R(64), s(20) 'Results
Dim m(6)
y = MsgBox("Locked", vbCritical, "Routine CnstrSqrs11a")
End
Sheets("Klad1").Select
t1 = Timer
k1 = 1: k2 = 1: n9 = 0: m2 = 8
m(1) = 1: m(2) = 2: m(3) = 4: m(4) = 8: m(5) = 16: m(6) = 32
GoSub 400 'Define Matrices A ... F
For j1 = 1 To 6
For j2 = 1 To 6
If j2 = j1 Then GoTo 20
For j3 = 1 To 6
If j3 = j2 Or j3 = j1 Then GoTo 30
For j4 = 1 To 6
If j4 = j3 Or j4 = j2 Or j4 = j1 Then GoTo 40
For j5 = 1 To 6
If j5 = j4 Or j5 = j3 Or j5 = j2 Or j5 = j1 Then GoTo 50
For j6 = 1 To 6
If j6 = j5 Or j6 = j4 Or j6 = j3 Or j6 = j2 Or j6 = j1 Then GoTo 60
' Calculate Matrix R
For i1 = 1 To 64
R(i1) = m(j1) * a(i1) + m(j2) * b(i1) + m(j3) * c(i1) + m(j4) * d(i1) + m(j5) * E(i1) + m(j6) * F(i1) + 1
Next i1
' Check Magic Properties
GoSub 900: If fl1 = 0 Then GoTo 60
' Check Bimagic Properties
GoSub 950: If fl1 = 0 Then GoTo 60
' Check Identical Integers
GoSub 800: If fl1 = 0 Then GoTo 60
n9 = n9 + 1
' GoSub 645 'Print results (Selected Numbers)
GoSub 650 'Print results (Squares)
60 Next j6
50 Next j5
40 Next j4
30 Next j3
20 Next j2
10 Next j1
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine CnstrSqrs11a")
End
' Define Matrices A ... F
400
a(1) = 0: a(2) = 0: a(3) = 0: a(4) = 0: a(5) = 1: a(6) = 1: a(7) = 1: a(8) = 1:
a(9) = 1: a(10) = 1: a(11) = 1: a(12) = 1: a(13) = 0: a(14) = 0: a(15) = 0: a(16) = 0:
a(17) = 0: a(18) = 0: a(19) = 0: a(20) = 0: a(21) = 1: a(22) = 1: a(23) = 1: a(24) = 1:
a(25) = 1: a(26) = 1: a(27) = 1: a(28) = 1: a(29) = 0: a(30) = 0: a(31) = 0: a(32) = 0:
a(33) = 0: a(34) = 0: a(35) = 0: a(36) = 0: a(37) = 1: a(38) = 1: a(39) = 1: a(40) = 1:
a(41) = 1: a(42) = 1: a(43) = 1: a(44) = 1: a(45) = 0: a(46) = 0: a(47) = 0: a(48) = 0:
a(49) = 0: a(50) = 0: a(51) = 0: a(52) = 0: a(53) = 1: a(54) = 1: a(55) = 1: a(56) = 1:
a(57) = 1: a(58) = 1: a(59) = 1: a(60) = 1: a(61) = 0: a(62) = 0: a(63) = 0: a(64) = 0:
b(1) = 0: b(2) = 0: b(3) = 1: b(4) = 1: b(5) = 1: b(6) = 1: b(7) = 0: b(8) = 0:
b(9) = 0: b(10) = 0: b(11) = 1: b(12) = 1: b(13) = 1: b(14) = 1: b(15) = 0: b(16) = 0:
b(17) = 1: b(18) = 1: b(19) = 0: b(20) = 0: b(21) = 0: b(22) = 0: b(23) = 1: b(24) = 1:
b(25) = 1: b(26) = 1: b(27) = 0: b(28) = 0: b(29) = 0: b(30) = 0: b(31) = 1: b(32) = 1:
b(33) = 0: b(34) = 0: b(35) = 1: b(36) = 1: b(37) = 1: b(38) = 1: b(39) = 0: b(40) = 0:
b(41) = 0: b(42) = 0: b(43) = 1: b(44) = 1: b(45) = 1: b(46) = 1: b(47) = 0: b(48) = 0:
b(49) = 1: b(50) = 1: b(51) = 0: b(52) = 0: b(53) = 0: b(54) = 0: b(55) = 1: b(56) = 1:
b(57) = 1: b(58) = 1: b(59) = 0: b(60) = 0: b(61) = 0: b(62) = 0: b(63) = 1: b(64) = 1:
c(1) = 0: c(2) = 1: c(3) = 0: c(4) = 1: c(5) = 0: c(6) = 1: c(7) = 0: c(8) = 1:
c(9) = 1: c(10) = 0: c(11) = 1: c(12) = 0: c(13) = 1: c(14) = 0: c(15) = 1: c(16) = 0:
c(17) = 1: c(18) = 0: c(19) = 1: c(20) = 0: c(21) = 1: c(22) = 0: c(23) = 1: c(24) = 0:
c(25) = 0: c(26) = 1: c(27) = 0: c(28) = 1: c(29) = 0: c(30) = 1: c(31) = 0: c(32) = 1:
c(33) = 1: c(34) = 0: c(35) = 1: c(36) = 0: c(37) = 1: c(38) = 0: c(39) = 1: c(40) = 0:
c(41) = 0: c(42) = 1: c(43) = 0: c(44) = 1: c(45) = 0: c(46) = 1: c(47) = 0: c(48) = 1:
c(49) = 0: c(50) = 1: c(51) = 0: c(52) = 1: c(53) = 0: c(54) = 1: c(55) = 0: c(56) = 1:
c(57) = 1: c(58) = 0: c(59) = 1: c(60) = 0: c(61) = 1: c(62) = 0: c(63) = 1: c(64) = 0:
d(1) = 0: d(2) = 1: d(3) = 1: d(4) = 0: d(5) = 0: d(6) = 1: d(7) = 1: d(8) = 0:
d(9) = 0: d(10) = 1: d(11) = 1: d(12) = 0: d(13) = 0: d(14) = 1: d(15) = 1: d(16) = 0:
d(17) = 1: d(18) = 0: d(19) = 0: d(20) = 1: d(21) = 1: d(22) = 0: d(23) = 0: d(24) = 1:
d(25) = 1: d(26) = 0: d(27) = 0: d(28) = 1: d(29) = 1: d(30) = 0: d(31) = 0: d(32) = 1:
d(33) = 1: d(34) = 0: d(35) = 0: d(36) = 1: d(37) = 1: d(38) = 0: d(39) = 0: d(40) = 1:
d(41) = 1: d(42) = 0: d(43) = 0: d(44) = 1: d(45) = 1: d(46) = 0: d(47) = 0: d(48) = 1:
d(49) = 0: d(50) = 1: d(51) = 1: d(52) = 0: d(53) = 0: d(54) = 1: d(55) = 1: d(56) = 0:
d(57) = 0: d(58) = 1: d(59) = 1: d(60) = 0: d(61) = 0: d(62) = 1: d(63) = 1: d(64) = 0:
E(1) = 1: E(2) = 0: E(3) = 1: E(4) = 0: E(5) = 0: E(6) = 1: E(7) = 0: E(8) = 1:
E(9) = 0: E(10) = 1: E(11) = 0: E(12) = 1: E(13) = 1: E(14) = 0: E(15) = 1: E(16) = 0:
E(17) = 0: E(18) = 1: E(19) = 0: E(20) = 1: E(21) = 1: E(22) = 0: E(23) = 1: E(24) = 0:
E(25) = 1: E(26) = 0: E(27) = 1: E(28) = 0: E(29) = 0: E(30) = 1: E(31) = 0: E(32) = 1:
E(33) = 1: E(34) = 0: E(35) = 1: E(36) = 0: E(37) = 0: E(38) = 1: E(39) = 0: E(40) = 1:
E(41) = 0: E(42) = 1: E(43) = 0: E(44) = 1: E(45) = 1: E(46) = 0: E(47) = 1: E(48) = 0:
E(49) = 0: E(50) = 1: E(51) = 0: E(52) = 1: E(53) = 1: E(54) = 0: E(55) = 1: E(56) = 0:
E(57) = 1: E(58) = 0: E(59) = 1: E(60) = 0: E(61) = 0: E(62) = 1: E(63) = 0: E(64) = 1:
F(1) = 1: F(2) = 1: F(3) = 0: F(4) = 0: F(5) = 1: F(6) = 1: F(7) = 0: F(8) = 0:
F(9) = 0: F(10) = 0: F(11) = 1: F(12) = 1: F(13) = 0: F(14) = 0: F(15) = 1: F(16) = 1:
F(17) = 1: F(18) = 1: F(19) = 0: F(20) = 0: F(21) = 1: F(22) = 1: F(23) = 0: F(24) = 0:
F(25) = 0: F(26) = 0: F(27) = 1: F(28) = 1: F(29) = 0: F(30) = 0: F(31) = 1: F(32) = 1:
F(33) = 0: F(34) = 0: F(35) = 1: F(36) = 1: F(37) = 0: F(38) = 0: F(39) = 1: F(40) = 1:
F(41) = 1: F(42) = 1: F(43) = 0: F(44) = 0: F(45) = 1: F(46) = 1: F(47) = 0: F(48) = 0:
F(49) = 0: F(50) = 0: F(51) = 1: F(52) = 1: F(53) = 0: F(54) = 0: F(55) = 1: F(56) = 1:
F(57) = 1: F(58) = 1: F(59) = 0: F(60) = 0: F(61) = 1: F(62) = 1: F(63) = 0: F(64) = 0:
Return
' Print Results (Selected Numbers)
645 i3 = 0
For i1 = 1 To m2
For i2 = 1 To m2
i3 = i3 + 1
Cells(n9, i3).Value = R(i3)
Next i2
Next i1
Return
' Print Results (Squares)
650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + m2 + 1: k2 = 1
Else
If n9 > 1 Then k2 = k2 + m2 + 1
End If
Cells(k1 + 1, k2 + 1).Select
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To m2
For i2 = 1 To m2
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = R(i3)
Next i2
Next i1
Return
' Check Magic Properties (Back Check)
900 fl1 = 1: s2 = 260
Erase s
s(1) = R(1) + R(2) + R(3) + R(4) + R(5) + R(6) + R(7) + R(8)
s(2) = R(9) + R(10) + R(11) + R(12) + R(13) + R(14) + R(15) + R(16)
s(3) = R(17) + R(18) + R(19) + R(20) + R(21) + R(22) + R(23) + R(24)
s(4) = R(25) + R(26) + R(27) + R(28) + R(29) + R(30) + R(31) + R(32)
s(5) = R(33) + R(34) + R(35) + R(36) + R(37) + R(38) + R(39) + R(40)
s(6) = R(41) + R(42) + R(43) + R(44) + R(45) + R(46) + R(47) + R(48)
s(7) = R(49) + R(50) + R(51) + R(52) + R(53) + R(54) + R(55) + R(56)
s(8) = R(57) + R(58) + R(59) + R(60) + R(61) + R(62) + R(63) + R(64)
s(9) = R(1) + R(9) + R(17) + R(25) + R(33) + R(41) + R(49) + R(57)
s(10) = R(2) + R(10) + R(18) + R(26) + R(34) + R(42) + R(50) + R(58)
s(11) = R(3) + R(11) + R(19) + R(27) + R(35) + R(43) + R(51) + R(59)
s(12) = R(4) + R(12) + R(20) + R(28) + R(36) + R(44) + R(52) + R(60)
s(13) = R(5) + R(13) + R(21) + R(29) + R(37) + R(45) + R(53) + R(61)
s(14) = R(6) + R(14) + R(22) + R(30) + R(38) + R(46) + R(54) + R(62)
s(15) = R(7) + R(15) + R(23) + R(31) + R(39) + R(47) + R(55) + R(63)
s(16) = R(8) + R(16) + R(24) + R(32) + R(40) + R(48) + R(56) + R(64)
s(17) = R(1) + R(10) + R(19) + R(28) + R(37) + R(46) + R(55) + R(64)
s(18) = R(8) + R(15) + R(22) + R(29) + R(36) + R(43) + R(50) + R(57)
' Check Simple Magic
For j20 = 1 To 18
If s(j20) <> s2 Then fl1 = 0: Exit For
Next j20
Return
' Check Bimagic Properties
950 fl1 = 1: s2 = 11180
Erase s
s(1) = R(1) ^ 2 + R(2) ^ 2 + R(3) ^ 2 + R(4) ^ 2 + R(5) ^ 2 + R(6) ^ 2 + R(7) ^ 2 + R(8) ^ 2
s(2) = R(9) ^ 2 + R(10) ^ 2 + R(11) ^ 2 + R(12) ^ 2 + R(13) ^ 2 + R(14) ^ 2 + R(15) ^ 2 + R(16) ^ 2
s(3) = R(17) ^ 2 + R(18) ^ 2 + R(19) ^ 2 + R(20) ^ 2 + R(21) ^ 2 + R(22) ^ 2 + R(23) ^ 2 + R(24) ^ 2
s(4) = R(25) ^ 2 + R(26) ^ 2 + R(27) ^ 2 + R(28) ^ 2 + R(29) ^ 2 + R(30) ^ 2 + R(31) ^ 2 + R(32) ^ 2
s(5) = R(33) ^ 2 + R(34) ^ 2 + R(35) ^ 2 + R(36) ^ 2 + R(37) ^ 2 + R(38) ^ 2 + R(39) ^ 2 + R(40) ^ 2
s(6) = R(41) ^ 2 + R(42) ^ 2 + R(43) ^ 2 + R(44) ^ 2 + R(45) ^ 2 + R(46) ^ 2 + R(47) ^ 2 + R(48) ^ 2
s(7) = R(49) ^ 2 + R(50) ^ 2 + R(51) ^ 2 + R(52) ^ 2 + R(53) ^ 2 + R(54) ^ 2 + R(55) ^ 2 + R(56) ^ 2
s(8) = R(57) ^ 2 + R(58) ^ 2 + R(59) ^ 2 + R(60) ^ 2 + R(61) ^ 2 + R(62) ^ 2 + R(63) ^ 2 + R(64) ^ 2
s(9) = R(1) ^ 2 + R(9) ^ 2 + R(17) ^ 2 + R(25) ^ 2 + R(33) ^ 2 + R(41) ^ 2 + R(49) ^ 2 + R(57) ^ 2
s(10) = R(2) ^ 2 + R(10) ^ 2 + R(18) ^ 2 + R(26) ^ 2 + R(34) ^ 2 + R(42) ^ 2 + R(50) ^ 2 + R(58) ^ 2
s(11) = R(3) ^ 2 + R(11) ^ 2 + R(19) ^ 2 + R(27) ^ 2 + R(35) ^ 2 + R(43) ^ 2 + R(51) ^ 2 + R(59) ^ 2
s(12) = R(4) ^ 2 + R(12) ^ 2 + R(20) ^ 2 + R(28) ^ 2 + R(36) ^ 2 + R(44) ^ 2 + R(52) ^ 2 + R(60) ^ 2
s(13) = R(5) ^ 2 + R(13) ^ 2 + R(21) ^ 2 + R(29) ^ 2 + R(37) ^ 2 + R(45) ^ 2 + R(53) ^ 2 + R(61) ^ 2
s(14) = R(6) ^ 2 + R(14) ^ 2 + R(22) ^ 2 + R(30) ^ 2 + R(38) ^ 2 + R(46) ^ 2 + R(54) ^ 2 + R(62) ^ 2
s(15) = R(7) ^ 2 + R(15) ^ 2 + R(23) ^ 2 + R(31) ^ 2 + R(39) ^ 2 + R(47) ^ 2 + R(55) ^ 2 + R(63) ^ 2
s(16) = R(8) ^ 2 + R(16) ^ 2 + R(24) ^ 2 + R(32) ^ 2 + R(40) ^ 2 + R(48) ^ 2 + R(56) ^ 2 + R(64) ^ 2
s(17) = R(1) ^ 2 + R(10) ^ 2 + R(19) ^ 2 + R(28) ^ 2 + R(37) ^ 2 + R(46) ^ 2 + R(55) ^ 2 + R(64) ^ 2
s(18) = R(8) ^ 2 + R(15) ^ 2 + R(22) ^ 2 + R(29) ^ 2 + R(36) ^ 2 + R(43) ^ 2 + R(50) ^ 2 + R(57) ^ 2
' Check Simple Bimagic
n8 = 0
For j20 = 1 To 18
If s(j20) <> s2 Then fl1 = 0: Exit For
''If s(j20) = s2 Then n8 = n8 + 1
Next j20
Return
' Check Identical Integers
800 fl1 = 1
For i1 = 1 To 64
c2 = R(i1)
For i2 = (1 + i1) To 64
If c2 = R(i2) Then fl1 = 0: Return
Next i2
Next i1
Return
End Sub
