' Generates Semi-Latin Squares of order 12
' Most Perfect Pan Magic Squares (1/3 Rows and 1/3 Columns)
' Tested with Office 365 under Windows 10
Sub CompLat12d()
Dim a(144), b(12)
y = MsgBox("Locked", vbCritical, "Routine CompLat12d")
End
n2 = 0: n9 = 0
m1 = 0: m2 = 11: s1 = 66
k1 = 1: k2 = 1
Pr12 = 11
' Generate data
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
For j142 = m1 To m2 'a(142)
a(142) = j142
a(141) = 4 * s1 / 12 - a(142) - a(143) - a(144): If a(141) < 0 Or a(141) > 11 Then GoTo 1420
For j140 = m1 To m2 'a(142)
a(140) = j140
a(139) = -a(140) + a(143) + a(144): If a(139) < 0 Or a(139) > 11 Then GoTo 1400
For j138 = m1 To m2 'a(138)
a(138) = j138
a(137) = 4 * s1 / 12 - a(138) - a(143) - a(144): If a(137) < 0 Or a(137) > 11 Then GoTo 1380
a(136) = a(138) - a(142) + a(144): If a(136) < 0 Or a(136) > 11 Then GoTo 1380
a(135) = -a(138) + a(142) + a(143): If a(135) < 0 Or a(135) > 11 Then GoTo 1380
a(134) = a(138) - a(140) + a(144): If a(134) < 0 Or a(134) > 11 Then GoTo 1380
a(133) = 4 * s1 / 12 - a(138) + a(140) - a(143) - 2 * a(144): If a(133) < 0 Or a(133) > 11 Then GoTo 1380
' Check Row 1
For i1 = 133 To 144: b(i1 - 132) = a(i1): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 1380
For j132 = m1 To m2 'a(132)
a(132) = j132
a(131) = 4 * s1 / 12 - a(132) - a(143) - a(144): If a(131) < 0 Or a(131) > 11 Then GoTo 1320
a(130) = a(132) - a(142) + a(144): If a(130) < 0 Or a(130) > 11 Then GoTo 1320
a(129) = -a(132) + a(142) + a(143): If a(129) < 0 Or a(129) > 11 Then GoTo 1320
a(128) = a(132) - a(140) + a(144): If a(128) < 0 Or a(128) > 11 Then GoTo 1320
a(127) = 4 * s1 / 12 - a(132) + a(140) - a(143) - 2 * a(144): If a(127) < 0 Or a(127) > 11 Then GoTo 1320
a(126) = a(132) - a(138) + a(144): If a(126) < 0 Or a(126) > 11 Then GoTo 1320
a(125) = -a(132) + a(138) + a(143): If a(125) < 0 Or a(125) > 11 Then GoTo 1320
a(124) = a(132) - a(138) + a(142): If a(124) < 0 Or a(124) > 11 Then GoTo 1320
a(123) = 4 * s1 / 12 - a(132) + a(138) - a(142) - a(143) - a(144):
If a(123) < 0 Or a(123) > 11 Then GoTo 1320
a(122) = a(132) - a(138) + a(140): If a(122) < 0 Or a(122) > 11 Then GoTo 1320
a(121) = -a(132) + a(138) - a(140) + a(143) + a(144): If a(121) < 0 Or a(121) > 11 Then GoTo 1320
' Check Row 2
For i1 = 121 To 132: b(i1 - 120) = a(i1): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 1320
For j120 = m1 To m2 'a(120)
a(120) = j120
a(119) = -a(120) + a(143) + a(144): If a(119) < 0 Or a(119) > 11 Then GoTo 1200
a(118) = a(120) + a(142) - a(144): If a(118) < 0 Or a(118) > 11 Then GoTo 1200
a(117) = 4 * s1 / 12 - a(120) - a(142) - a(143): If a(117) < 0 Or a(117) > 11 Then GoTo 1200
a(116) = a(120) + a(140) - a(144): If a(116) < 0 Or a(116) > 11 Then GoTo 1200
a(115) = -a(120) - a(140) + a(143) + 2 * a(144): If a(115) < 0 Or a(115) > 11 Then GoTo 1200
a(114) = a(120) + a(138) - a(144): If a(114) < 0 Or a(114) > 11 Then GoTo 1200
a(113) = 4 * s1 / 12 - a(120) - a(138) - a(143): If a(113) < 0 Or a(113) > 11 Then GoTo 1200
a(112) = a(120) + a(138) - a(142): If a(112) < 0 Or a(112) > 11 Then GoTo 1200
a(111) = -a(120) - a(138) + a(142) + a(143) + a(144): If a(111) < 0 Or a(111) > 11 Then GoTo 1200
a(110) = a(120) + a(138) - a(140): If a(110) < 0 Or a(110) > 11 Then GoTo 1200
a(109) = 4 * s1 / 12 - a(120) - a(138) + a(140) - a(143) - a(144):
If a(109) < 0 Or a(109) > 11 Then GoTo 1200
' Check Row 3
For i1 = 109 To 120: b(i1 - 108) = a(i1): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 1200
a(108) = 4 * s1 / 12 - a(120) - a(132) - a(144): If a(108) < 0 Or a(108) > 11 Then GoTo 1200
a(107) = a(120) + a(132) - a(143): If a(107) < 0 Or a(107) > 11 Then GoTo 1200
a(106) = 4 * s1 / 12 - a(120) - a(132) - a(142): If a(106) < 0 Or a(106) > 11 Then GoTo 1200
a(105) = -4 * s1 / 12 + a(120) + a(132) + a(142) + a(143) + a(144): If a(105) < 0 Or a(105) > 11 Then GoTo 1200
a(104) = 4 * s1 / 12 - a(120) - a(132) - a(140): If a(104) < 0 Or a(104) > 11 Then GoTo 1200
a(103) = a(120) + a(132) + a(140) - a(143) - a(144): If a(103) < 0 Or a(103) > 11 Then GoTo 1200
a(102) = 4 * s1 / 12 - a(120) - a(132) - a(138): If a(102) < 0 Or a(102) > 11 Then GoTo 1200
a(101) = -4 * s1 / 12 + a(120) + a(132) + a(138) + a(143) + a(144): If a(101) < 0 Or a(101) > 11 Then GoTo 1200
a(100) = 4 * s1 / 12 - a(120) - a(132) - a(138) + a(142) - a(144): If a(100) < 0 Or a(100) > 11 Then GoTo 1200
a(99) = a(120) + a(132) + a(138) - a(142) - a(143): If a(99) < 0 Or a(99) > 11 Then GoTo 1200
a(98) = 4 * s1 / 12 - a(120) - a(132) - a(138) + a(140) - a(144): If a(98) < 0 Or a(98) > 11 Then GoTo 1200
a(97) = -4 * s1 / 12 + a(120) + a(132) + a(138) - a(140) + a(143) + 2 * a(144):
If a(97) < 0 Or a(97) > 11 Then GoTo 1200
' Check Row 4
For i1 = 97 To 108: b(i1 - 96) = a(i1): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 1200
For j96 = m1 To m2 'a(96)
a(96) = j96
a(95) = -a(96) + a(143) + a(144): If a(95) < 0 Or a(95) > 11 Then GoTo 960
a(94) = a(96) + a(142) - a(144): If a(94) < 0 Or a(94) > 11 Then GoTo 960
a(93) = 4 * s1 / 12 - a(96) - a(142) - a(143): If a(93) < 0 Or a(93) > 11 Then GoTo 960
a(92) = a(96) + a(140) - a(144): If a(92) < 0 Or a(92) > 11 Then GoTo 960
a(91) = -a(96) - a(140) + a(143) + 2 * a(144): If a(91) < 0 Or a(91) > 11 Then GoTo 960
a(90) = a(96) + a(138) - a(144): If a(90) < 0 Or a(90) > 11 Then GoTo 960
a(89) = 4 * s1 / 12 - a(96) - a(138) - a(143): If a(89) < 0 Or a(89) > 11 Then GoTo 960
a(88) = a(96) + a(138) - a(142): If a(88) < 0 Or a(88) > 11 Then GoTo 960
a(87) = -a(96) - a(138) + a(142) + a(143) + a(144): If a(87) < 0 Or a(87) > 11 Then GoTo 960
a(86) = a(96) + a(138) - a(140): If a(86) < 0 Or a(86) > 11 Then GoTo 960
a(85) = 4 * s1 / 12 - a(96) - a(138) + a(140) - a(143) - a(144): If a(85) < 0 Or a(85) > 11 Then GoTo 960
' Check Row 5
For i1 = 85 To 96: b(i1 - 84) = a(i1): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 960
a(84) = -a(96) + a(132) + a(144): If a(84) < 0 Or a(84) > 11 Then GoTo 960
a(83) = 4 * s1 / 12 + a(96) - a(132) - a(143) - 2 * a(144): If a(83) < 0 Or a(83) > 11 Then GoTo 960
a(82) = -a(96) + a(132) - a(142) + 2 * a(144): If a(82) < 0 Or a(82) > 11 Then GoTo 960
a(81) = a(96) - a(132) + a(142) + a(143) - a(144): If a(81) < 0 Or a(81) > 11 Then GoTo 960
a(80) = -a(96) + a(132) - a(140) + 2 * a(144): If a(80) < 0 Or a(80) > 11 Then GoTo 960
a(79) = 4 * s1 / 12 + a(96) - a(132) + a(140) - a(143) - 3 * a(144): If a(79) < 0 Or a(79) > 11 Then GoTo 960
a(78) = -a(96) + a(132) - a(138) + 2 * a(144): If a(78) < 0 Or a(78) > 11 Then GoTo 960
a(77) = a(96) - a(132) + a(138) + a(143) - a(144): If a(77) < 0 Or a(77) > 11 Then GoTo 960
a(76) = -a(96) + a(132) - a(138) + a(142) + a(144): If a(76) < 0 Or a(76) > 11 Then GoTo 960
a(75) = 4 * s1 / 12 + a(96) - a(132) + a(138) - a(142) - a(143) - 2 * a(144):
If a(75) < 0 Or a(75) > 11 Then GoTo 960
a(74) = -a(96) + a(132) - a(138) + a(140) + a(144): If a(74) < 0 Or a(74) > 11 Then GoTo 960
a(73) = a(96) - a(132) + a(138) - a(140) + a(143): If a(73) < 0 Or a(73) > 11 Then GoTo 960
' Check Row 6
For i1 = 73 To 84: b(i1 - 72) = a(i1): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 960
' Complete
a(72) = Pr12 - a(138): a(71) = Pr12 - a(137): a(70) = Pr12 - a(136): a(69) = Pr12 - a(135):
a(68) = Pr12 - a(134): a(67) = Pr12 - a(133): a(66) = Pr12 - a(144): a(65) = Pr12 - a(143):
a(64) = Pr12 - a(142): a(63) = Pr12 - a(141): a(62) = Pr12 - a(140): a(61) = Pr12 - a(139):
a(60) = Pr12 - a(126): a(59) = Pr12 - a(125): a(58) = Pr12 - a(124): a(57) = Pr12 - a(123):
a(56) = Pr12 - a(122): a(55) = Pr12 - a(121): a(54) = Pr12 - a(132): a(53) = Pr12 - a(131):
a(52) = Pr12 - a(130): a(51) = Pr12 - a(129): a(50) = Pr12 - a(128): a(49) = Pr12 - a(127):
a(48) = Pr12 - a(114): a(47) = Pr12 - a(113): a(46) = Pr12 - a(112): a(45) = Pr12 - a(111):
a(44) = Pr12 - a(110): a(43) = Pr12 - a(109): a(42) = Pr12 - a(120): a(41) = Pr12 - a(119):
a(40) = Pr12 - a(118): a(39) = Pr12 - a(117): a(38) = Pr12 - a(116): a(37) = Pr12 - a(115):
a(36) = Pr12 - a(102): a(35) = Pr12 - a(101): a(34) = Pr12 - a(100): a(33) = Pr12 - a(99):
a(32) = Pr12 - a(98): a(31) = Pr12 - a(97): a(30) = Pr12 - a(108): a(29) = Pr12 - a(107):
a(28) = Pr12 - a(106): a(27) = Pr12 - a(105): a(26) = Pr12 - a(104): a(25) = Pr12 - a(103):
a(24) = Pr12 - a(90): a(23) = Pr12 - a(89): a(22) = Pr12 - a(88): a(21) = Pr12 - a(87):
a(20) = Pr12 - a(86): a(19) = Pr12 - a(85): a(18) = Pr12 - a(96): a(17) = Pr12 - a(95):
a(16) = Pr12 - a(94): a(15) = Pr12 - a(93): a(14) = Pr12 - a(92): a(13) = Pr12 - a(91):
a(12) = Pr12 - a(78): a(11) = Pr12 - a(77): a(10) = Pr12 - a(76): a(9) = Pr12 - a(75):
a(8) = Pr12 - a(74): a(7) = Pr12 - a(73): a(6) = Pr12 - a(84): a(5) = Pr12 - a(83):
a(4) = Pr12 - a(82): a(3) = Pr12 - a(81): a(2) = Pr12 - a(80): a(1) = Pr12 - a(79):
'Check Diagonal 1
i2 = 1
For i1 = 1 To 12:
b(i1) = a(i2): i2 = i2 + 13
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 960
'Check Diagonal 2
i2 = 12
For i1 = 1 To 12:
b(i1) = a(i2): i2 = i2 + 11
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 960
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers)
' Cells(1, 1).Value = n9 'Counting
960 Next j96
1200 Next j120
1320 Next j132
1380 Next j138
1400 Next j140
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 CompLat12d")
End
' Exclude solutions with identical numbers Latin Lines Order 12
1800 fl1 = 1
For j1 = 1 To 12
a2 = b(j1):
For j2 = (1 + j1) To 12
If a2 = b(j2) Then fl1 = 0: Return
Next j2
1810 Next j1
Return
' Print results (selected numbers)
2645 For i1 = 1 To 144
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 145).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 + 1, k2 + 1).Select
Cells(k1, k2 + 1).Select
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 = a(i3)
Next i2
Next i1
Return
End Sub
