' Generates Semi-Latin Pan Magic Squares of order 12
' Compact and Complete, All 1/2 Rows and 1/2 Columns sum to s1/2
' Tested with Office 365 under Windows 10
Sub CompLat12f()
Dim a(144), b(144), c(144), s(128)
Dim a2(144), b2(144)
y = MsgBox("Locked", vbCritical, "Routine CompLat12f")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 0: m2 = 11: s1 = 66: p1 = s1 / 6
' Generate Semi Latin Squares
Sheets("Klad1").Select
t1 = Timer
For j144 = m1 To m2 'a(144)
a(144) = j144
For j143 = m1 To m2 'a(143)
a(143) = j143
If a(143) = a(144) Then GoTo 1430
For j142 = m1 To m2 'a(142)
a(142) = j142
If a(142) = a(143) Or a(142) = a(144) Then GoTo 1420
For j141 = m1 To m2 'a(141)
a(141) = j141
If a(141) = a(142) Or a(141) = a(143) Or a(141) = a(144) Then GoTo 1410
For j140 = m1 To m2 'a(140)
a(140) = j140
If a(140) = a(141) Or a(140) = a(142) Or a(140) = a(143) Or a(140) = a(144) Then GoTo 1400
a(139) = s1 / 2 - a(140) - a(141) - a(142) - a(143) - a(144):
If a(139) < m1 Or a(139) > m2 Then GoTo 1400:
If a(139) = a(140) Or a(139) = a(141) Or a(139) = a(142) Or a(139) = a(143) Or a(139) = a(144) Then GoTo 1400
For j138 = m1 To m2 'a(138)
a(138) = j138
If a(138) = a(140) Or a(138) = a(141) Or a(138) = a(142) Or a(138) = a(143) Or a(138) = a(144) Then GoTo 1380
If a(138) = a(139) Then GoTo 1380
a(137) = s1 / 3 - a(138) - a(143) - a(144): If a(137) < m1 Or a(137) > m2 Then GoTo 1380:
a(136) = a(138) - a(142) + a(144): If a(136) < m1 Or a(136) > m2 Then GoTo 1380:
a(135) = s1 / 3 - a(138) - a(141) - a(144): If a(135) < m1 Or a(135) > m2 Then GoTo 1380:
a(134) = a(138) - a(140) + a(144): If a(134) < m1 Or a(134) > m2 Then GoTo 1380:
a(133) = -s1 / 6 - a(138) + a(140) + a(141) + a(142) + a(143):
If a(133) < m1 Or a(133) > m2 Then GoTo 1380:
m11 = 133: m21 = 144: GoSub 2700: If fl1 = 0 Then GoTo 1380 'Check row 1
For j132 = m1 To m2 'a(132)
a(132) = j132
a(131) = s1 / 3 - a(132) - a(143) - a(144): If a(131) < m1 Or a(131) > m2 Then GoTo 1320:
a(130) = a(132) - a(142) + a(144): If a(130) < m1 Or a(130) > m2 Then GoTo 1320:
a(129) = s1 / 3 - a(132) - a(141) - a(144): If a(129) < m1 Or a(129) > m2 Then GoTo 1320:
a(128) = a(132) - a(140) + a(144): If a(128) < m1 Or a(128) > m2 Then GoTo 1320:
a(127) = -s1 / 6 - a(132) + a(140) + a(141) + a(142) + a(143):
If a(127) < m1 Or a(127) > m2 Then GoTo 1320:
a(126) = a(132) - a(138) + a(144): If a(126) < m1 Or a(126) > m2 Then GoTo 1320:
a(125) = -a(132) + a(138) + a(143): If a(125) < m1 Or a(125) > m2 Then GoTo 1320:
a(124) = a(132) - a(138) + a(142): If a(124) < m1 Or a(124) > m2 Then GoTo 1320:
a(123) = -a(132) + a(138) + a(141): If a(123) < m1 Or a(123) > m2 Then GoTo 1320:
a(122) = a(132) - a(138) + a(140): If a(122) < m1 Or a(122) > m2 Then GoTo 1320:
a(121) = s1 / 2 - a(132) + a(138) - a(140) - a(141) - a(142) - a(143) - a(144):
If a(121) < m1 Or a(121) > m2 Then GoTo 1320:
m11 = 121: m21 = 132: GoSub 2700: If fl1 = 0 Then GoTo 1320 'Check row 2
For j120 = m1 To m2 'a(120)
a(120) = j120
a(119) = -a(120) + a(143) + a(144): If a(119) < m1 Or a(119) > m2 Then GoTo 1200:
a(118) = a(120) + a(142) - a(144): If a(118) < m1 Or a(118) > m2 Then GoTo 1200:
a(117) = -a(120) + a(141) + a(144): If a(117) < m1 Or a(117) > m2 Then GoTo 1200:
a(116) = a(120) + a(140) - a(144): If a(116) < m1 Or a(116) > m2 Then GoTo 1200:
a(115) = s1 / 2 - a(120) - a(140) - a(141) - a(142) - a(143):
If a(115) < m1 Or a(115) > m2 Then GoTo 1200:
a(114) = a(120) + a(138) - a(144): If a(114) < m1 Or a(114) > m2 Then GoTo 1200:
a(113) = s1 / 3 - a(120) - a(138) - a(143): If a(113) < m1 Or a(113) > m2 Then GoTo 1200:
a(112) = a(120) + a(138) - a(142): If a(112) < m1 Or a(112) > m2 Then GoTo 1200:
a(111) = s1 / 3 - a(120) - a(138) - a(141): If a(111) < m1 Or a(111) > m2 Then GoTo 1200:
a(110) = a(120) + a(138) - a(140): If a(110) < m1 Or a(110) > m2 Then GoTo 1200:
a(109) = -s1 / 6 - a(120) - a(138) + a(140) + a(141) + a(142) + a(143) + a(144)
If a(109) < m1 Or a(109) > m2 Then GoTo 1200:
m11 = 109: m21 = 120: GoSub 2700: If fl1 = 0 Then GoTo 1200 'Check row 3
For j108 = m1 To m2 'a(108)
a(108) = j108
a(107) = s1 / 3 - a(108) - a(143) - a(144): If a(107) < m1 Or a(107) > m2 Then GoTo 1080:
a(106) = a(108) - a(142) + a(144): If a(106) < m1 Or a(106) > m2 Then GoTo 1080:
a(105) = s1 / 3 - a(108) - a(141) - a(144): If a(105) < m1 Or a(105) > m2 Then GoTo 1080:
a(104) = a(108) - a(140) + a(144): If a(104) < m1 Or a(104) > m2 Then GoTo 1080:
a(103) = -s1 / 6 - a(108) + a(140) + a(141) + a(142) + a(143):
If a(103) < m1 Or a(103) > m2 Then GoTo 1080:
a(102) = a(108) - a(138) + a(144): If a(102) < m1 Or a(102) > m2 Then GoTo 1080:
a(101) = -a(108) + a(138) + a(143): If a(101) < m1 Or a(101) > m2 Then GoTo 1080:
a(100) = a(108) - a(138) + a(142): If a(100) < m1 Or a(100) > m2 Then GoTo 1080:
a(99) = -a(108) + a(138) + a(141): If a(99) < m1 Or a(99) > m2 Then GoTo 1080:
a(98) = a(108) - a(138) + a(140): If a(98) < m1 Or a(98) > m2 Then GoTo 1080:
a(97) = s1 / 2 - a(108) + a(138) - a(140) - a(141) - a(142) - a(143) - a(144):
If a(97) < m1 Or a(97) > m2 Then GoTo 1080:
m11 = 97: m21 = 108: GoSub 2700: If fl1 = 0 Then GoTo 1080 'Check row 4
For j96 = m1 To m2 'a(96)
a(96) = j96
a(95) = -a(96) + a(143) + a(144): If a(95) < m1 Or a(95) > m2 Then GoTo 960:
a(94) = a(96) + a(142) - a(144): If a(94) < m1 Or a(94) > m2 Then GoTo 960:
a(93) = -a(96) + a(141) + a(144): If a(93) < m1 Or a(93) > m2 Then GoTo 960:
a(92) = a(96) + a(140) - a(144): If a(92) < m1 Or a(92) > m2 Then GoTo 960:
a(91) = s1 / 2 - a(96) - a(140) - a(141) - a(142) - a(143):
If a(91) < m1 Or a(91) > m2 Then GoTo 960:
a(90) = a(96) + a(138) - a(144): If a(90) < m1 Or a(90) > m2 Then GoTo 960:
a(89) = s1 / 3 - a(96) - a(138) - a(143): If a(89) < m1 Or a(89) > m2 Then GoTo 960:
a(88) = a(96) + a(138) - a(142): If a(88) < m1 Or a(88) > m2 Then GoTo 960:
a(87) = s1 / 3 - a(96) - a(138) - a(141): If a(87) < m1 Or a(87) > m2 Then GoTo 960:
a(86) = a(96) + a(138) - a(140): If a(86) < m1 Or a(86) > m2 Then GoTo 960:
a(85) = -s1 / 6 - a(96) - a(138) + a(140) + a(141) + a(142) + a(143) + a(144):
If a(85) < m1 Or a(85) > m2 Then GoTo 960:
m11 = 85: m21 = 96: GoSub 2700: If fl1 = 0 Then GoTo 960 'Check row 5
a(84) = s1 / 2 - a(96) - a(108) - a(120) - a(132) - a(144):
If a(84) < m1 Or a(84) > m2 Then GoTo 960:
a(83) = -s1 / 6 + a(96) + a(108) + a(120) + a(132) - a(143):
If a(83) < m1 Or a(83) > m2 Then GoTo 960:
a(82) = s1 / 2 - a(96) - a(108) - a(120) - a(132) - a(142):
If a(82) < m1 Or a(82) > m2 Then GoTo 960:
a(81) = -s1 / 6 + a(96) + a(108) + a(120) + a(132) - a(141):
If a(81) < m1 Or a(81) > m2 Then GoTo 960:
a(80) = s1 / 2 - a(96) - a(108) - a(120) - a(132) - a(140):
If a(80) < m1 Or a(80) > m2 Then GoTo 960:
a(79) = -2 * s1 / 3 + a(96) + a(108) + a(120) + a(132) + a(140) + a(141) + a(142) + a(143) + a(144):
If a(79) < m1 Or a(79) > m2 Then GoTo 960:
a(78) = s1 / 2 - a(96) - a(108) - a(120) - a(132) - a(138):
If a(78) < m1 Or a(78) > m2 Then GoTo 960:
a(77) = -s1 / 2 + a(96) + a(108) + a(120) + a(132) + a(138) + a(143) + a(144):
If a(77) < m1 Or a(77) > m2 Then GoTo 960:
a(76) = s1 / 2 - a(96) - a(108) - a(120) - a(132) - a(138) + a(142) - a(144):
If a(76) < m1 Or a(76) > m2 Then GoTo 960:
a(75) = -s1 / 2 + a(96) + a(108) + a(120) + a(132) + a(138) + a(141) + a(144):
If a(75) < m1 Or a(75) > m2 Then GoTo 960:
a(74) = s1 / 2 - a(96) - a(108) - a(120) - a(132) - a(138) + a(140) - a(144):
If a(74) < m1 Or a(74) > m2 Then GoTo 960:
a(73) = a(96) + a(108) + a(120) + a(132) + a(138) - a(140) - a(141) - a(142) - a(143):
If a(73) < m1 Or a(73) > m2 Then GoTo 960:
m11 = 73: m21 = 84: GoSub 2700: If fl1 = 0 Then GoTo 960 'Check row 6
GoSub 3000 'Complete Sem-Latin Square
GoSub 2750: If fl1 = 0 Then GoTo 960 'Check diagonal 1, 2
' Calculate c() = 12 * a2() + b2() + 1
Erase a2
For i1 = 1 To 144: a2(i1) = a(i1): Next i1
GoSub 1500: If fl1 = 0 Then GoTo 960
n9 = n9 + 1 'Total
' GoSub 2600 'Print results (Lines)
GoSub 2650 'Print results (Squares)
' Cells(2, 1).Value = n9 'Counting
' GoTo 1440 'Print only first square for j144
End
960 Next j96
1080 Next j108
1200 Next j120
1320 Next j132
1380 Next j138
1400 Next j140
1410 Next j141
1420 Next j142
1430 Next j143
1440 Next j144
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine CompLat12f")
End
' Complete Semi-Latin Squares
3000
a(1) = p1 - a(79): a(2) = p1 - a(80): a(3) = p1 - a(81): a(4) = p1 - a(82): a(5) = p1 - a(83): a(6) = p1 - a(84):
a(7) = p1 - a(73): a(8) = p1 - a(74): a(9) = p1 - a(75): a(10) = p1 - a(76): a(11) = p1 - a(77): a(12) = p1 - a(78):
a(13) = p1 - a(91): a(14) = p1 - a(92): a(15) = p1 - a(93): a(16) = p1 - a(94): a(17) = p1 - a(95): a(18) = p1 - a(96):
a(19) = p1 - a(85): a(20) = p1 - a(86): a(21) = p1 - a(87): a(22) = p1 - a(88): a(23) = p1 - a(89): a(24) = p1 - a(90):
a(25) = p1 - a(103): a(26) = p1 - a(104): a(27) = p1 - a(105): a(28) = p1 - a(106): a(29) = p1 - a(107): a(30) = p1 - a(108):
a(31) = p1 - a(97): a(32) = p1 - a(98): a(33) = p1 - a(99): a(34) = p1 - a(100): a(35) = p1 - a(101): a(36) = p1 - a(102):
a(37) = p1 - a(115): a(38) = p1 - a(116): a(39) = p1 - a(117): a(40) = p1 - a(118): a(41) = p1 - a(119): a(42) = p1 - a(120):
a(43) = p1 - a(109): a(44) = p1 - a(110): a(45) = p1 - a(111): a(46) = p1 - a(112): a(47) = p1 - a(113): a(48) = p1 - a(114):
a(49) = p1 - a(127): a(50) = p1 - a(128): a(51) = p1 - a(129): a(52) = p1 - a(130): a(53) = p1 - a(131): a(54) = p1 - a(132):
a(55) = p1 - a(121): a(56) = p1 - a(122): a(57) = p1 - a(123): a(58) = p1 - a(124): a(59) = p1 - a(125): a(60) = p1 - a(126):
a(61) = p1 - a(139): a(62) = p1 - a(140): a(63) = p1 - a(141): a(64) = p1 - a(142): a(65) = p1 - a(143): a(66) = p1 - a(144):
a(67) = p1 - a(133): a(68) = p1 - a(134): a(69) = p1 - a(135): a(70) = p1 - a(136): a(71) = p1 - a(137): a(72) = p1 - a(138):
Return
' Construct Pan Magic, Compact, Complete Squares
1500 fl1 = 1
' Transpose a2()
b2(1) = a2(1): b2(2) = a2(13): b2(3) = a2(25): b2(4) = a2(37): b2(5) = a2(49): b2(6) = a2(61):
b2(7) = a2(73): b2(8) = a2(85): b2(9) = a2(97): b2(10) = a2(109): b2(11) = a2(121): b2(12) = a2(133):
b2(13) = a2(2): b2(14) = a2(14): b2(15) = a2(26): b2(16) = a2(38): b2(17) = a2(50): b2(18) = a2(62):
b2(19) = a2(74): b2(20) = a2(86): b2(21) = a2(98): b2(22) = a2(110): b2(23) = a2(122): b2(24) = a2(134):
b2(25) = a2(3): b2(26) = a2(15): b2(27) = a2(27): b2(28) = a2(39): b2(29) = a2(51): b2(30) = a2(63):
b2(31) = a2(75): b2(32) = a2(87): b2(33) = a2(99): b2(34) = a2(111): b2(35) = a2(123): b2(36) = a2(135):
b2(37) = a2(4): b2(38) = a2(16): b2(39) = a2(28): b2(40) = a2(40): b2(41) = a2(52): b2(42) = a2(64):
b2(43) = a2(76): b2(44) = a2(88): b2(45) = a2(100): b2(46) = a2(112): b2(47) = a2(124): b2(48) = a2(136):
b2(49) = a2(5): b2(50) = a2(17): b2(51) = a2(29): b2(52) = a2(41): b2(53) = a2(53): b2(54) = a2(65):
b2(55) = a2(77): b2(56) = a2(89): b2(57) = a2(101): b2(58) = a2(113): b2(59) = a2(125): b2(60) = a2(137):
b2(61) = a2(6): b2(62) = a2(18): b2(63) = a2(30): b2(64) = a2(42): b2(65) = a2(54): b2(66) = a2(66):
b2(67) = a2(78): b2(68) = a2(90): b2(69) = a2(102): b2(70) = a2(114): b2(71) = a2(126): b2(72) = a2(138):
b2(73) = a2(7): b2(74) = a2(19): b2(75) = a2(31): b2(76) = a2(43): b2(77) = a2(55): b2(78) = a2(67):
b2(79) = a2(79): b2(80) = a2(91): b2(81) = a2(103): b2(82) = a2(115): b2(83) = a2(127): b2(84) = a2(139):
b2(85) = a2(8): b2(86) = a2(20): b2(87) = a2(32): b2(88) = a2(44): b2(89) = a2(56): b2(90) = a2(68):
b2(91) = a2(80): b2(92) = a2(92): b2(93) = a2(104): b2(94) = a2(116): b2(95) = a2(128): b2(96) = a2(140):
b2(97) = a2(9): b2(98) = a2(21): b2(99) = a2(33): b2(100) = a2(45): b2(101) = a2(57): b2(102) = a2(69):
b2(103) = a2(81): b2(104) = a2(93): b2(105) = a2(105): b2(106) = a2(117): b2(107) = a2(129): b2(108) = a2(141):
b2(109) = a2(10): b2(110) = a2(22): b2(111) = a2(34): b2(112) = a2(46): b2(113) = a2(58): b2(114) = a2(70):
b2(115) = a2(82): b2(116) = a2(94): b2(117) = a2(106): b2(118) = a2(118): b2(119) = a2(130): b2(120) = a2(142):
b2(121) = a2(11): b2(122) = a2(23): b2(123) = a2(35): b2(124) = a2(47): b2(125) = a2(59): b2(126) = a2(71):
b2(127) = a2(83): b2(128) = a2(95): b2(129) = a2(107): b2(130) = a2(119): b2(131) = a2(131): b2(132) = a2(143):
b2(133) = a2(12): b2(134) = a2(24): b2(135) = a2(36): b2(136) = a2(48): b2(137) = a2(60): b2(138) = a2(72):
b2(139) = a2(84): b2(140) = a2(96): b2(141) = a2(108): b2(142) = a2(120): b2(143) = a2(132): b2(144) = a2(144):
Erase c
For i1 = 1 To 144
c(i1) = 12 * a2(i1) + b2(i1) + 1
Next i1
' Check identical numbers
fl1 = 1: n20 = 0
For j1 = 1 To 144
a20 = c(j1):
For j2 = (1 + j1) To 144
If a20 = c(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
' Print Results (lines)
2600
For i1 = 1 To 144
Cells(n9, i1).Value = b2(i1) ''a(i1)
Next i1
Cells(n9, 145).Value = n9
Cells(1, 146).Value = n9
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 3 Then
n2 = 1: k1 = k1 + 13: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 13
End If
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To 12
For i2 = 1 To 12
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = b2(i3) ''c(i3)
Next i2
Next i1
Return
' Check Row i (i = 1 ... 12)
2700 fl1 = 1
For i1 = m11 To m21: b(i1 - m11 + 1) = a(i1): Next i1
For j1 = 1 To 12
a20 = b(j1):
For j2 = (1 + j1) To 12
If a20 = b(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
' Check Diagonals 1, 2
2750 fl1 = 1
i2 = 1
For i1 = 1 To 12:
b(i1) = a(i2): i2 = i2 + 13
Next i1
For j1 = 1 To 12
a20 = b(j1):
For j2 = (1 + j1) To 12
If a20 = b(j2) Then fl1 = 0: Return
Next j2
Next j1
i2 = 12
For i1 = 1 To 12:
b(i1) = a(i2): i2 = i2 + 11
Next i1
For j1 = 1 To 12
a20 = b(j1):
For j2 = (1 + j1) To 12
If a20 = b(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
End Sub
