' Constructs Associated Semi-Latin Squares (11 x 11)
' Diamond Inlays Order 5 and 6 (Part 1)
' Tested with Office 365 under Windows 10
Sub SemiLat11a()
Dim a(121), a1(11), b(11)
Dim a2(121), b2(121), c(121)
y = MsgBox("Locked", vbCritical, "Routine SemiLat11a")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
For i1 = 1 To 11
a1(i1) = i1 - 1
Next i1
m1 = 1: m2 = 11: s1 = 55: p11 = 2 * s1 / 11
Sheets("Klad1").Select
t1 = Timer
a(61) = 5
For j66 = 1 To 1 ''m1 To m2 'a(66) Diamond 6 x 6
a(66) = a1(j66)
a(56) = p11 - a(66)
For j76 = m1 To m2 'a(76)
a(76) = a1(j76)
a(46) = p11 - a(76)
For j54 = m1 To m2 'a(54)
a(54) = a1(j54)
a(64) = 2 * p11 - a(54) - a(76) - a(66)
If a(64) < a1(m1) Or a(64) > a1(m2) Then GoTo 540
a(58) = p11 - a(64): a(68) = p11 - a(54)
For j86 = m1 To m2 'a(86)
a(86) = a1(j86)
a(36) = p11 - a(86)
For j96 = m1 To m2 'a(96)
a(96) = a1(j96)
a(26) = p11 - a(96)
For j74 = m1 To m2 'a(74)
a(74) = a1(j74)
a(84) = 2 * p11 - a(74) - a(96) - a(86)
If a(84) < a1(m1) Or a(84) > a1(m2) Then GoTo 740
a(38) = p11 - a(84): a(48) = p11 - a(74)
For j106 = m1 To m2 'a(106)
a(106) = a1(j106)
a(116) = 6 * s1 / 11 - a(106) - a(96) - a(86) - a(76) - a(66)
If a(116) < a1(m1) Or a(116) > a1(m2) Then GoTo 1060
a(6) = p11 - a(116): a(16) = p11 - a(106)
For j94 = m1 To m2 'a(94)
a(94) = a1(j94)
a(104) = 6 * s1 / 11 - a(94) - a(84) - a(74) - a(64) - a(54)
If a(104) < a1(m1) Or a(104) > a1(m2) Then GoTo 940
a(18) = p11 - a(104): a(28) = p11 - a(94)
For j42 = m1 To m2 'a(42)
a(42) = a1(j42)
a(80) = p11 - a(42)
For j52 = m1 To m2 'a(52)
a(52) = a1(j52)
a(62) = 5 * s1 / 11 - a(52) - a(42) - a(74) - a(86)
If a(62) < a1(m1) Or a(62) > a1(m2) Then GoTo 520
a(72) = s1 / 11 - a(52) - a(42) + a(74) + a(86)
If a(72) < a1(m1) Or a(72) > a1(m2) Then GoTo 520
a(82) = 2 * p11 + a(52) - a(94) - a(54) - a(106) - a(66)
If a(82) < a1(m1) Or a(82) > a1(m2) Then GoTo 520
a(92) = -2 * p11 + a(42) + a(94) + a(54) + a(106) + a(66)
If a(92) < a1(m1) Or a(92) > a1(m2) Then GoTo 520
a(30) = p11 - a(92): a(40) = p11 - a(82): a(50) = p11 - a(72): a(60) = p11 - a(62): a(70) = p11 - a(52)
' Check Diamond 6 x 6
n10 = 2: b(1) = a(104): b(2) = a(106)
GoSub 1800: If fl1 = 0 Then GoTo 520
n10 = 3: b(1) = a(92): b(2) = a(94): b(3) = a(96)
GoSub 1800: If fl1 = 0 Then GoTo 520
n10 = 4: b(1) = a(80): b(2) = a(82): b(3) = a(84): b(4) = a(86)
GoSub 1800: If fl1 = 0 Then GoTo 520
n10 = 5: b(1) = a(68): b(2) = a(70): b(3) = a(72): b(4) = a(74): b(5) = a(76)
GoSub 1800: If fl1 = 0 Then GoTo 520
n10 = 6: b(1) = a(56): b(2) = a(58): b(3) = a(60): b(4) = a(62): b(5) = a(64): b(6) = a(66)
GoSub 1800: If fl1 = 0 Then GoTo 520
' Intermediate Check Diamond 6 x 6
Erase a2
a2(56) = a(56): a2(46) = a(46): a2(36) = a(36): a2(26) = a(26): a2(16) = a(16): a2(6) = a(6):
a2(68) = a(68): a2(58) = a(58): a2(48) = a(48): a2(38) = a(38): a2(28) = a(28): a2(18) = a(18):
a2(80) = a(80): a2(70) = a(70): a2(60) = a(60): a2(50) = a(50): a2(40) = a(40): a2(30) = a(30):
a2(92) = a(92): a2(82) = a(82): a2(72) = a(72): a2(62) = a(62): a2(52) = a(52): a2(42) = a(42):
a2(104) = a(104): a2(94) = a(94): a2(84) = a(84): a2(74) = a(74): a2(64) = a(64): a2(54) = a(54):
a2(116) = a(116): a2(106) = a(106): a2(96) = a(96): a2(86) = a(86): a2(76) = a(76): a2(66) = a(66):
GoSub 1500: If fl1 = 0 Then GoTo 520
' Diamond 5 x 5
For j65 = m1 To m2 'a(65) Diamond 5 x 5
a(65) = a1(j65)
a(57) = p11 - a(65)
For j75 = m1 To m2 'a(75)
a(75) = a1(j75)
a(47) = p11 - a(75)
For j85 = m1 To m2 'a(85)
a(85) = a1(j85)
a(37) = p11 - a(85)
For j95 = m1 To m2 'a(95)
a(95) = a1(j95)
a(27) = p11 - a(95)
a(105) = 5 * s1 / 11 - a(95) - a(85) - a(75) - a(65)
If a(105) < a1(m1) Or a(105) > a1(m2) Then GoTo 950
a(17) = p11 - a(105)
For j53 = m1 To m2 'a(53)
a(53) = a1(j53)
a(69) = p11 - a(53)
For j63 = m1 To m2 'a(63)
a(63) = a1(j63)
a(59) = p11 - a(63)
For j73 = m1 To m2 'a(73)
a(73) = a1(j73)
a(49) = p11 - a(73)
For j83 = m1 To m2 'a(83)
a(83) = a1(j83)
a(93) = 5 * s1 / 11 - a(83) - a(73) - a(63) - a(53)
If a(93) < a1(m1) Or a(93) > a1(m2) Then GoTo 830
a(41) = s1 / 11 + a(93) - a(53) + a(105) - a(65)
If a(41) < a1(m1) Or a(41) > a1(m2) Then GoTo 830
a(51) = s1 / 11 + a(83) - a(63) + a(95) - a(75)
If a(51) < a1(m1) Or a(51) > a1(m2) Then GoTo 830
a(39) = p11 - a(83): a(71) = p11 - a(51): a(81) = p11 - a(41): a(29) = p11 - a(93)
' Check Diamonds 5 x 5 / 6 x 6
n10 = 3: For i1 = 1 To n10: b(i1) = a(i1 + 103): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 830
n10 = 5: For i1 = 1 To n10: b(i1) = a(i1 + 91): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 830
n10 = 7: For i1 = 1 To n10: b(i1) = a(i1 + 79): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 830
n10 = 9: For i1 = 1 To n10: b(i1) = a(i1 + 67): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 830
n10 = 11: For i1 = 1 To n10: b(i1) = a(i1 + 55): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 830
' Diagonals
n10 = 5: b(1) = a(37): b(2) = a(49): b(3) = a(61): b(4) = a(73): b(5) = a(85)
GoSub 1800: If fl1 = 0 Then GoTo 830
n10 = 5: b(1) = a(41): b(2) = a(51): b(3) = a(61): b(4) = a(71): b(5) = a(81)
GoSub 1800: If fl1 = 0 Then GoTo 830
' Calculate c() = 11 * a2() + b2() + 1
Erase a2
For i1 = 1 To 121: a2(i1) = a(i1): Next i1
GoSub 1500: If fl1 = 0 Then GoTo 830
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers
' Cells(1, 1).Value = n9 'Counting
830 Next j83
730 Next j73
630 Next j63
530 Next j53
950 Next j95
850 Next j85
750 Next j75
650 Next j65
520 Next j52
420 Next j42
940 Next j94
1060 Next j106
740 Next j74
960 Next j96
860 Next j86
540 Next j54
760 Next j76
660 Next j66
1000
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine SemiLat11a")
End
1500 fl1 = 1
' Rotated (Option)
'' b2(1) = a2(111): b2(2) = a2(100): b2(3) = a2(89): b2(4) = a2(78): b2(5) = a2(67): b2(6) = a2(56):
'' b2(7) = a2(45): b2(8) = a2(34): b2(9) = a2(23): b2(10) = a2(12): b2(11) = a2(1):
'' b2(12) = a2(112): b2(13) = a2(101): b2(14) = a2(90): b2(15) = a2(79): b2(16) = a2(68): b2(17) = a2(57):
'' b2(18) = a2(46): b2(19) = a2(35): b2(20) = a2(24): b2(21) = a2(13): b2(22) = a2(2):
'' b2(23) = a2(113): b2(24) = a2(102): b2(25) = a2(91): b2(26) = a2(80): b2(27) = a2(69): b2(28) = a2(58):
'' b2(29) = a2(47): b2(30) = a2(36): b2(31) = a2(25): b2(32) = a2(14): b2(33) = a2(3):
'' b2(34) = a2(114): b2(35) = a2(103): b2(36) = a2(92): b2(37) = a2(81): b2(38) = a2(70): b2(39) = a2(59):
'' b2(40) = a2(48): b2(41) = a2(37): b2(42) = a2(26): b2(43) = a2(15): b2(44) = a2(4):
'' b2(45) = a2(115): b2(46) = a2(104): b2(47) = a2(93): b2(48) = a2(82): b2(49) = a2(71): b2(50) = a2(60):
'' b2(51) = a2(49): b2(52) = a2(38): b2(53) = a2(27): b2(54) = a2(16): b2(55) = a2(5):
'' b2(56) = a2(116): b2(57) = a2(105): b2(58) = a2(94): b2(59) = a2(83): b2(60) = a2(72): b2(61) = a2(61):
'' b2(62) = a2(50): b2(63) = a2(39): b2(64) = a2(28): b2(65) = a2(17): b2(66) = a2(6):
'' b2(67) = a2(117): b2(68) = a2(106): b2(69) = a2(95): b2(70) = a2(84): b2(71) = a2(73): b2(72) = a2(62):
'' b2(73) = a2(51): b2(74) = a2(40): b2(75) = a2(29): b2(76) = a2(18): b2(77) = a2(7):
'' b2(78) = a2(118): b2(79) = a2(107): b2(80) = a2(96): b2(81) = a2(85): b2(82) = a2(74): b2(83) = a2(63):
'' b2(84) = a2(52): b2(85) = a2(41): b2(86) = a2(30): b2(87) = a2(19): b2(88) = a2(8):
'' b2(89) = a2(119): b2(90) = a2(108): b2(91) = a2(97): b2(92) = a2(86): b2(93) = a2(75): b2(94) = a2(64):
'' b2(95) = a2(53): b2(96) = a2(42): b2(97) = a2(31): b2(98) = a2(20): b2(99) = a2(9):
'' b2(100) = a2(120): b2(101) = a2(109): b2(102) = a2(98): b2(103) = a2(87): b2(104) = a2(76): b2(105) = a2(65):
'' b2(106) = a2(54): b2(107) = a2(43): b2(108) = a2(32): b2(109) = a2(21): b2(110) = a2(10):
'' b2(111) = a2(121): b2(112) = a2(110): b2(113) = a2(99): b2(114) = a2(88): b2(115) = a2(77): b2(116) = a2(66):
'' b2(117) = a2(55): b2(118) = a2(44): b2(119) = a2(33): b2(120) = a2(22): b2(121) = a2(11):
' Transpose (Option)
b2(1) = a2(1): b2(2) = a2(12): b2(3) = a2(23): b2(4) = a2(34): b2(5) = a2(45): b2(6) = a2(56):
b2(7) = a2(67): b2(8) = a2(78): b2(9) = a2(89): b2(10) = a2(100): b2(11) = a2(111):
b2(12) = a2(2): b2(13) = a2(13): b2(14) = a2(24): b2(15) = a2(35): b2(16) = a2(46): b2(17) = a2(57):
b2(18) = a2(68): b2(19) = a2(79): b2(20) = a2(90): b2(21) = a2(101): b2(22) = a2(112):
b2(23) = a2(3): b2(24) = a2(14): b2(25) = a2(25): b2(26) = a2(36): b2(27) = a2(47): b2(28) = a2(58):
b2(29) = a2(69): b2(30) = a2(80): b2(31) = a2(91): b2(32) = a2(102): b2(33) = a2(113):
b2(34) = a2(4): b2(35) = a2(15): b2(36) = a2(26): b2(37) = a2(37): b2(38) = a2(48): b2(39) = a2(59):
b2(40) = a2(70): b2(41) = a2(81): b2(42) = a2(92): b2(43) = a2(103): b2(44) = a2(114):
b2(45) = a2(5): b2(46) = a2(16): b2(47) = a2(27): b2(48) = a2(38): b2(49) = a2(49): b2(50) = a2(60):
b2(51) = a2(71): b2(52) = a2(82): b2(53) = a2(93): b2(54) = a2(104): b2(55) = a2(115):
b2(56) = a2(6): b2(57) = a2(17): b2(58) = a2(28): b2(59) = a2(39): b2(60) = a2(50): b2(61) = a2(61):
b2(62) = a2(72): b2(63) = a2(83): b2(64) = a2(94): b2(65) = a2(105): b2(66) = a2(116):
b2(67) = a2(7): b2(68) = a2(18): b2(69) = a2(29): b2(70) = a2(40): b2(71) = a2(51): b2(72) = a2(62):
b2(73) = a2(73): b2(74) = a2(84): b2(75) = a2(95): b2(76) = a2(106): b2(77) = a2(117):
b2(78) = a2(8): b2(79) = a2(19): b2(80) = a2(30): b2(81) = a2(41): b2(82) = a2(52): b2(83) = a2(63):
b2(84) = a2(74): b2(85) = a2(85): b2(86) = a2(96): b2(87) = a2(107): b2(88) = a2(118):
b2(89) = a2(9): b2(90) = a2(20): b2(91) = a2(31): b2(92) = a2(42): b2(93) = a2(53): b2(94) = a2(64):
b2(95) = a2(75): b2(96) = a2(86): b2(97) = a2(97): b2(98) = a2(108): b2(99) = a2(119):
b2(100) = a2(10): b2(101) = a2(21): b2(102) = a2(32): b2(103) = a2(43): b2(104) = a2(54): b2(105) = a2(65):
b2(106) = a2(76): b2(107) = a2(87): b2(108) = a2(98): b2(109) = a2(109): b2(110) = a2(120):
b2(111) = a2(11): b2(112) = a2(22): b2(113) = a2(33): b2(114) = a2(44): b2(115) = a2(55): b2(116) = a2(66):
b2(117) = a2(77): b2(118) = a2(88): b2(119) = a2(99): b2(120) = a2(110): b2(121) = a2(121):
Erase c
For i1 = 1 To 121
c(i1) = 11 * a2(i1) + b2(i1) + 1
Next i1
fl1 = 1: n20 = 0
For j1 = 1 To 121
a20 = c(j1): If a20 = 1 Then GoTo 1510 '*** Testing Purposes ***
For j2 = (1 + j1) To 121
If a20 = c(j2) Then fl1 = 0: Return
Next j2
1510 Next j1
Return
' Exclude solutions with identical numbers Latin Lines Order 11
1800 fl1 = 1
For j1 = 1 To n10
a20 = b(j1):
For j2 = (1 + j1) To n10
If a20 = b(j2) Then fl1 = 0: Return
Next j2
1810 Next j1
Return
' Print results (selected numbers)
2645 For i1 = 1 To 121
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 122).Value = n9
Cells(1, 123).Value = n9
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 12: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 12
End If
Cells(1, 1).Value = n9
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(n9)
i3 = 0
For i1 = 1 To 11
For i2 = 1 To 11
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = c(i3) ''c(i3)
Next i2
Next i1
Return
End Sub
