' Generates Semi Latin Squares of order 14
(Symmetrical Diagonals / Composed Border)
' Tested with Office 365 under Windows 10
Sub SemiLat14()
Dim a(14, 14), a1(14), d1(14), d2(14)
Dim b(14, 14), c(14, 14), c1(196)
y = MsgBox("Blocked", 0, "SemiLat14")
End
Sheets("Klad1").Select
k1 = 1: k2 = 1
t1 = Timer
' Set Diagonals
For i1 = 1 To 14
d1(i1) = i1 - 1
d2(i1) = i1 - 1
Next i1
For j1 = 116 To 116
i10 = j1: i20 = 1: GoSub 200
If fl1 = 0 Then GoTo 10
For j2 = 3972 To 3972
i10 = j2: i20 = 2: GoSub 200
If fl1 = 0 Then GoTo 20
GoSub 350: If fl1 = 0 Then GoTo 20
For j3 = 9760 To 9760
i10 = j3: i20 = 3: GoSub 200
If fl1 = 0 Then GoTo 30
GoSub 350: If fl1 = 0 Then GoTo 30
For j4 = 10416 To 10416
i10 = j4: i20 = 4: GoSub 200
If fl1 = 0 Then GoTo 40
GoSub 350: If fl1 = 0 Then GoTo 40
For j5 = 17042 To 17042
i10 = j5: i20 = 5: GoSub 200
If fl1 = 0 Then GoTo 50
GoSub 350: If fl1 = 0 Then GoTo 50
For j6 = 17162 To 20593
i10 = j6: i20 = 6: GoSub 200
If fl1 = 0 Then GoTo 60
For j7 = 20594 To 24025
i10 = j7: i20 = 7: GoSub 200
If fl1 = 0 Then GoTo 70
GoSub 300: If fl1 = 0 Then GoTo 70 'Check Square
'' n9 = n9 + 1: GoSub 650 'Print Result
n9 = n9 + 1: Cells(1, 1).Value = n9 'Count Only
70 Next j7
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 Latin14a")
End
' Read, Check and Store
200 fl1 = 1
For i1 = 1 To 14
a1(i1) = Sheets("MgcLns14").Cells(i10, i1).Value
Next i1
If a1(i20) <> d1(i20) Then fl1 = 0: Return
If a1(15 - i20) <> d2(i20) Then fl1 = 0: Return
' Check Outer Border (Option)
If i20 >= 3 Then
s4 = a1(1) + a1(2) + a1(13) + a1(14)
If s4 <> 26 Then fl1 = 0: Return
End If
' Check Inner Border (Option)
If i20 >= 5 Then
s4 = a1(3) + a1(4) + a1(11) + a1(12)
If s4 <> 26 Then fl1 = 0: Return
End If
For i1 = 1 To 14 'Store
a(i20, i1) = a1(i1)
a(15 - i20, i1) = 13 - a1(i1) 'Complement
Next i1
Return
' Intermediate Check
350 fl1 = 1
For i1 = 1 To 14
For i2 = 1 To 14
b(i1, i2) = a(i2, i1)
Next i2
Next i1
i3 = 0
For i1 = 1 To 14
For i2 = 1 To 14
c(i1, i2) = a(i1, i2) + 14 * b(i1, i2) + 1
i3 = i3 + 1: c1(i3) = c(i1, i2)
Next i2
Next i1
Select Case i20
Case 2
c1(1) = c(1, 1): c1(2) = c(1, 2): c1(3) = c(1, 13): c1(4) = c(1, 14):
c1(5) = c(2, 1): c1(6) = c(2, 2): c1(7) = c(2, 13): c1(8) = c(2, 14):
c1(9) = c(13, 1): c1(10) = c(13, 2): c1(11) = c(13, 13): c1(12) = c(13, 14):
c1(13) = c(14, 1): c1(14) = c(14, 2): c1(15) = c(14, 13): c1(16) = c(14, 14):
n10 = 16
Case 3
c1(1) = c(1, 1): c1(2) = c(1, 2): c1(3) = c(1, 3):
c1(4) = c(1, 12): c1(5) = c(1, 13): c1(6) = c(1, 14):
c1(7) = c(2, 1): c1(8) = c(2, 2): c1(9) = c(2, 3):
c1(10) = c(2, 12): c1(11) = c(2, 13): c1(12) = c(2, 14):
c1(13) = c(3, 1): c1(14) = c(3, 2): c1(15) = c(3, 3):
c1(16) = c(3, 12): c1(17) = c(3, 13): c1(18) = c(3, 14):
c1(19) = c(12, 1): c1(20) = c(12, 2): c1(21) = c(12, 3):
c1(22) = c(12, 12): c1(23) = c(12, 13): c1(24) = c(12, 14):
c1(25) = c(13, 1): c1(26) = c(13, 2): c1(27) = c(13, 3):
c1(28) = c(13, 12): c1(29) = c(13, 13): c1(30) = c(13, 14):
c1(31) = c(14, 1): c1(32) = c(14, 2): c1(33) = c(14, 3):
c1(34) = c(14, 12): c1(35) = c(14, 13): c1(36) = c(14, 14):
n10 = 36
Case 4
c1(1) = c(1, 1): c1(2) = c(1, 2): c1(3) = c(1, 3): c1(4) = c(1, 4):
c1(5) = c(1, 11): c1(6) = c(1, 12): c1(7) = c(1, 13): c1(8) = c(1, 14):
c1(9) = c(2, 1): c1(10) = c(2, 2): c1(11) = c(2, 3): c1(12) = c(2, 4):
c1(13) = c(2, 11): c1(14) = c(2, 12): c1(15) = c(2, 13): c1(16) = c(2, 14):
c1(17) = c(3, 1): c1(18) = c(3, 2): c1(19) = c(3, 3): c1(20) = c(3, 4):
c1(21) = c(3, 11): c1(22) = c(3, 12): c1(23) = c(3, 13): c1(24) = c(3, 14):
c1(25) = c(4, 1): c1(26) = c(4, 2): c1(27) = c(4, 3): c1(28) = c(4, 4):
c1(29) = c(4, 11): c1(30) = c(4, 12): c1(31) = c(4, 13): c1(32) = c(4, 14):
c1(33) = c(11, 1): c1(34) = c(11, 2): c1(35) = c(11, 3): c1(36) = c(11, 4):
c1(37) = c(11, 11): c1(38) = c(11, 12): c1(39) = c(11, 13): c1(40) = c(11, 14):
c1(41) = c(12, 1): c1(42) = c(12, 2): c1(43) = c(12, 3): c1(44) = c(12, 4):
c1(45) = c(12, 11): c1(46) = c(12, 12): c1(47) = c(12, 13): c1(48) = c(12, 14):
c1(49) = c(13, 1): c1(50) = c(13, 2): c1(51) = c(13, 3): c1(52) = c(13, 4):
c1(53) = c(13, 11): c1(54) = c(13, 12): c1(55) = c(13, 13): c1(56) = c(13, 14):
c1(57) = c(14, 1): c1(58) = c(14, 2): c1(59) = c(14, 3): c1(60) = c(14, 4):
c1(61) = c(14, 11): c1(62) = c(14, 12): c1(63) = c(14, 13): c1(64) = c(14, 14):
n10 = 64
Case 5
c1(1) = c(1, 1): c1(2) = c(1, 2): c1(3) = c(1, 3): c1(4) = c(1, 4): c1(5) = c(1, 5):
c1(6) = c(1, 10): c1(7) = c(1, 11): c1(8) = c(1, 12): c1(9) = c(1, 13): c1(10) = c(1, 14):
c1(11) = c(2, 1): c1(12) = c(2, 2): c1(13) = c(2, 3): c1(14) = c(2, 4): c1(15) = c(2, 5):
c1(16) = c(2, 10): c1(17) = c(2, 11): c1(18) = c(2, 12): c1(19) = c(2, 13): c1(20) = c(2, 14):
c1(21) = c(3, 1): c1(22) = c(3, 2): c1(23) = c(3, 3): c1(24) = c(3, 4): c1(25) = c(3, 5):
c1(26) = c(3, 10): c1(27) = c(3, 11): c1(28) = c(3, 12): c1(29) = c(3, 13): c1(30) = c(3, 14):
c1(31) = c(4, 1): c1(32) = c(4, 2): c1(33) = c(4, 3): c1(34) = c(4, 4): c1(35) = c(4, 5):
c1(36) = c(4, 10): c1(37) = c(4, 11): c1(38) = c(4, 12): c1(39) = c(4, 13): c1(40) = c(4, 14):
c1(41) = c(5, 1): c1(42) = c(5, 2): c1(43) = c(5, 3): c1(44) = c(5, 4): c1(45) = c(5, 5):
c1(46) = c(5, 10): c1(47) = c(5, 11): c1(48) = c(5, 12): c1(49) = c(5, 13): c1(50) = c(5, 14):
c1(51) = c(10, 1): c1(52) = c(10, 2): c1(53) = c(10, 3): c1(54) = c(10, 4): c1(55) = c(10, 5):
c1(56) = c(10, 10): c1(57) = c(10, 11): c1(58) = c(10, 12): c1(59) = c(10, 13): c1(60) = c(10, 14):
c1(61) = c(11, 1): c1(62) = c(11, 2): c1(63) = c(11, 3): c1(64) = c(11, 4): c1(65) = c(11, 5):
c1(66) = c(11, 10): c1(67) = c(11, 11): c1(68) = c(11, 12): c1(69) = c(11, 13): c1(70) = c(11, 14):
c1(71) = c(12, 1): c1(72) = c(12, 2): c1(73) = c(12, 3): c1(74) = c(12, 4): c1(75) = c(12, 5):
c1(76) = c(12, 10): c1(77) = c(12, 11): c1(78) = c(12, 12): c1(79) = c(12, 13): c1(80) = c(12, 14):
c1(81) = c(13, 1): c1(82) = c(13, 2): c1(83) = c(13, 3): c1(84) = c(13, 4): c1(85) = c(13, 5):
c1(86) = c(13, 10): c1(87) = c(13, 11): c1(88) = c(13, 12): c1(89) = c(13, 13): c1(90) = c(13, 14):
c1(91) = c(14, 1): c1(92) = c(14, 2): c1(93) = c(14, 3): c1(94) = c(14, 4): c1(95) = c(14, 5):
c1(96) = c(14, 10): c1(97) = c(14, 11): c1(98) = c(14, 12): c1(99) = c(14, 13): c1(100) = c(14, 14):
n10 = 100
End Select
For i1 = 1 To n10
c2 = c1(i1)
For i2 = (1 + i1) To n10
If c2 = c1(i2) Then fl1 = 0: Return
Next i2
Next i1
Return
' Calculate and Check Square
300 fl1 = 1
For i1 = 1 To 14
For i2 = 1 To 14
b(i1, i2) = a(i2, i1)
Next i2
Next i1
i3 = 0
For i1 = 1 To 14
For i2 = 1 To 14
c(i1, i2) = a(i1, i2) + 14 * b(i1, i2) + 1
i3 = i3 + 1: c1(i3) = c(i1, i2)
Next i2
Next i1
For i1 = 1 To 196
c2 = c1(i1)
For i2 = (1 + i1) To 196
If c2 = c1(i2) Then fl1 = 0: Return
Next i2
Next i1
Return
' Print results (squares)
650 n1 = n1 + 1
If n1 = 5 Then
n1 = 1: k1 = k1 + 15: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 15
End If
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To 14
For i2 = 1 To 14
''i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = c(i1, i2)
Next i2
Next i1
Return
End Sub
