' Generates Ternary Squares of order 9 for integers 0, 1, 2
' Tested with Office 2007 under Windows 7
Sub Ternary9()
Dim a(81), b(9), s9(3)
y = MsgBox("Locked", vbCritical, "Routine Ternary9")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 0: m2 = 2: s1 = 9
' Generate data
Sheets("Klad1").Select
t1 = Timer
For j81 = m1 To m2 'a(81)
a(81) = j81
For j80 = m1 To m2 'a(80)
a(80) = j80
For j79 = m1 To m2 'a(79)
a(79) = j79
For j78 = m1 To m2 'a(78)
a(78) = j78
For j77 = m1 To m2 'a(77)
a(77) = j77
For j76 = m1 To m2 'a(76)
a(76) = j76
For j75 = m1 To m2 'a(75)
a(75) = j75
For j74 = m1 To m2 'a(74)
a(74) = j74
a(73) = s1 - a(74) - a(75) - a(76) - a(77) - a(78) - a(79) - a(80) - a(81): If a(73) < m1 Or a(73) > m2 Then GoTo 740
For j72 = m1 To m2 'a(72)
a(72) = j72
For j71 = m1 To m2 'a(71)
a(71) = j71
For j70 = m1 To m2 'a(70)
a(70) = j70
For j69 = m1 To m2 'a(69)
a(69) = j69
For j68 = m1 To m2 'a(68)
a(68) = j68
For j67 = m1 To m2 'a(67)
a(67) = j67
For j66 = m1 To m2 'a(66)
a(66) = j66
For j65 = m1 To m2 'a(65)
a(65) = j65
a(64) = s1 - a(65) - a(66) - a(67) - a(68) - a(69) - a(70) - a(71) - a(72): If a(64) < m1 Or a(64) > m2 Then GoTo 650
For j63 = m1 To m2 'a(63)
a(63) = j63
For j62 = m1 To m2 'a(62)
a(62) = j62
a(61) = s1 - a(62) - a(63) - a(70) - a(71) - a(72) - a(79) - a(80) - a(81): If a(61) < m1 Or a(61) > m2 Then GoTo 620
a(60) = s1 - a(61) - a(62) - a(69) - a(70) - a(71) - a(78) - a(79) - a(80): If a(60) < m1 Or a(60) > m2 Then GoTo 620
a(59) = s1 - a(60) - a(61) - a(68) - a(69) - a(70) - a(77) - a(78) - a(79): If a(59) < m1 Or a(59) > m2 Then GoTo 620
a(58) = s1 - a(59) - a(60) - a(67) - a(68) - a(69) - a(76) - a(77) - a(78): If a(58) < m1 Or a(58) > m2 Then GoTo 620
a(57) = s1 - a(58) - a(59) - a(66) - a(67) - a(68) - a(75) - a(76) - a(77): If a(57) < m1 Or a(57) > m2 Then GoTo 620
a(56) = s1 - a(57) - a(58) - a(65) - a(66) - a(67) - a(74) - a(75) - a(76): If a(56) < m1 Or a(56) > m2 Then GoTo 620
a(55) = s1 - a(56) - a(57) - a(64) - a(65) - a(66) - a(73) - a(74) - a(75): If a(55) < m1 Or a(55) > m2 Then GoTo 620
For j54 = m1 To m2 'a(54)
a(54) = j54
a(27) = s1 / 3 - a(54) - a(75) - a(78) + a(81): If a(27) < m1 Or a(27) > m2 Then GoTo 540
For j53 = m1 To m2 'a(53)
a(53) = j53
a(26) = s1 / 3 - a(53) - a(74) - a(77) + a(80): If a(26) < m1 Or a(26) > m2 Then GoTo 530
a(52) = s1 - a(53) - a(54) - a(61) - a(62) - a(63) - a(70) - a(71) - a(72): If a(52) < m1 Or a(52) > m2 Then GoTo 530
a(51) = s1 - a(52) - a(53) - a(60) - a(61) - a(62) - a(69) - a(70) - a(71): If a(51) < m1 Or a(51) > m2 Then GoTo 530
a(50) = s1 - a(51) - a(52) - a(59) - a(60) - a(61) - a(68) - a(69) - a(70): If a(50) < m1 Or a(50) > m2 Then GoTo 530
a(49) = s1 - a(50) - a(51) - a(58) - a(59) - a(60) - a(67) - a(68) - a(69): If a(49) < m1 Or a(49) > m2 Then GoTo 530
a(48) = s1 - a(49) - a(50) - a(57) - a(58) - a(59) - a(66) - a(67) - a(68): If a(48) < m1 Or a(48) > m2 Then GoTo 530
a(47) = s1 - a(48) - a(49) - a(56) - a(57) - a(58) - a(65) - a(66) - a(67): If a(47) < m1 Or a(47) > m2 Then GoTo 530
a(46) = s1 - a(47) - a(48) - a(55) - a(56) - a(57) - a(64) - a(65) - a(66): If a(46) < m1 Or a(46) > m2 Then GoTo 530
For j45 = m1 To m2 'a(45)
a(45) = j45
a(18) = s1 / 3 - a(45) - a(66) - a(69) + a(72): If a(18) < m1 Or a(18) > m2 Then GoTo 450
For j44 = m1 To m2 'a(44)
a(44) = j44
a(17) = s1 / 3 - a(44) - a(65) - a(68) + a(71): If a(17) < m1 Or a(17) > m2 Then GoTo 440
a(43) = s1 - a(44) - a(45) - a(52) - a(53) - a(54) - a(61) - a(62) - a(63): If a(43) < m1 Or a(43) > m2 Then GoTo 440
a(42) = s1 - a(43) - a(44) - a(51) - a(52) - a(53) - a(60) - a(61) - a(62): If a(42) < m1 Or a(42) > m2 Then GoTo 440
a(41) = s1 - a(42) - a(43) - a(50) - a(51) - a(52) - a(59) - a(60) - a(61): If a(41) < m1 Or a(41) > m2 Then GoTo 440
a(40) = s1 - a(41) - a(42) - a(49) - a(50) - a(51) - a(58) - a(59) - a(60): If a(40) < m1 Or a(40) > m2 Then GoTo 440
a(39) = s1 - a(40) - a(41) - a(48) - a(49) - a(50) - a(57) - a(58) - a(59): If a(39) < m1 Or a(39) > m2 Then GoTo 440
a(38) = s1 - a(39) - a(40) - a(47) - a(48) - a(49) - a(56) - a(57) - a(58): If a(38) < m1 Or a(38) > m2 Then GoTo 440
a(37) = s1 - a(38) - a(39) - a(46) - a(47) - a(48) - a(55) - a(56) - a(57): If a(37) < m1 Or a(37) > m2 Then GoTo 440
For j36 = m1 To m2 'a(36)
a(36) = j36
For j35 = m1 To m2 'a(35)
a(35) = j35
a(34) = s1 - a(35) - a(36) - a(43) - a(44) - a(45) - a(52) - a(53) - a(54): If a(34) < m1 Or a(34) > m2 Then GoTo 350
a(33) = s1 - a(34) - a(35) - a(42) - a(43) - a(44) - a(51) - a(52) - a(53): If a(33) < m1 Or a(33) > m2 Then GoTo 350
a(32) = s1 - a(33) - a(34) - a(41) - a(42) - a(43) - a(50) - a(51) - a(52): If a(32) < m1 Or a(32) > m2 Then GoTo 350
a(31) = s1 - a(32) - a(33) - a(40) - a(41) - a(42) - a(49) - a(50) - a(51): If a(31) < m1 Or a(31) > m2 Then GoTo 350
a(30) = s1 - a(31) - a(32) - a(39) - a(40) - a(41) - a(48) - a(49) - a(50): If a(30) < m1 Or a(30) > m2 Then GoTo 350
a(29) = s1 - a(30) - a(31) - a(38) - a(39) - a(40) - a(47) - a(48) - a(49): If a(29) < m1 Or a(29) > m2 Then GoTo 350
a(28) = s1 - a(29) - a(30) - a(37) - a(38) - a(39) - a(46) - a(47) - a(48): If a(28) < m1 Or a(28) > m2 Then GoTo 350
a(25) = s1 - a(26) - a(27) - a(34) - a(35) - a(36) - a(43) - a(44) - a(45): If a(25) < m1 Or a(25) > m2 Then GoTo 350
a(24) = s1 - a(25) - a(26) - a(33) - a(34) - a(35) - a(42) - a(43) - a(44): If a(24) < m1 Or a(24) > m2 Then GoTo 350
a(23) = s1 - a(24) - a(25) - a(32) - a(33) - a(34) - a(41) - a(42) - a(43): If a(23) < m1 Or a(23) > m2 Then GoTo 350
a(22) = s1 - a(23) - a(24) - a(31) - a(32) - a(33) - a(40) - a(41) - a(42): If a(22) < m1 Or a(22) > m2 Then GoTo 350
a(21) = s1 - a(22) - a(23) - a(30) - a(31) - a(32) - a(39) - a(40) - a(41): If a(21) < m1 Or a(21) > m2 Then GoTo 350
a(20) = s1 - a(21) - a(22) - a(29) - a(30) - a(31) - a(38) - a(39) - a(40): If a(20) < m1 Or a(20) > m2 Then GoTo 350
a(19) = s1 - a(20) - a(21) - a(28) - a(29) - a(30) - a(37) - a(38) - a(39): If a(19) < m1 Or a(19) > m2 Then GoTo 350
a(16) = s1 - a(17) - a(18) - a(25) - a(26) - a(27) - a(34) - a(35) - a(36): If a(16) < m1 Or a(16) > m2 Then GoTo 350
a(15) = s1 - a(16) - a(17) - a(24) - a(25) - a(26) - a(33) - a(34) - a(35): If a(15) < m1 Or a(15) > m2 Then GoTo 350
a(14) = s1 - a(15) - a(16) - a(23) - a(24) - a(25) - a(32) - a(33) - a(34): If a(14) < m1 Or a(14) > m2 Then GoTo 350
a(13) = s1 - a(14) - a(15) - a(22) - a(23) - a(24) - a(31) - a(32) - a(33): If a(13) < m1 Or a(13) > m2 Then GoTo 350
a(12) = s1 - a(13) - a(14) - a(21) - a(22) - a(23) - a(30) - a(31) - a(32): If a(12) < m1 Or a(12) > m2 Then GoTo 350
a(11) = s1 - a(12) - a(13) - a(20) - a(21) - a(22) - a(29) - a(30) - a(31): If a(11) < m1 Or a(11) > m2 Then GoTo 350
a(10) = s1 - a(11) - a(12) - a(19) - a(20) - a(21) - a(28) - a(29) - a(30): If a(10) < m1 Or a(10) > m2 Then GoTo 350
a(9) = s1 - a(17) - a(25) - a(33) - a(41) - a(49) - a(57) - a(65) - a(73): If a(9) < m1 Or a(9) > m2 Then GoTo 350
a(8) = s1 - a(16) - a(24) - a(32) - a(40) - a(48) - a(56) - a(64) - a(81): If a(8) < m1 Or a(8) > m2 Then GoTo 350
a(7) = s1 - a(8) - a(9) - a(16) - a(17) - a(18) - a(25) - a(26) - a(27): If a(7) < m1 Or a(7) > m2 Then GoTo 350
a(6) = s1 - a(7) - a(8) - a(15) - a(16) - a(17) - a(24) - a(25) - a(26): If a(6) < m1 Or a(6) > m2 Then GoTo 350
a(5) = s1 - a(6) - a(7) - a(14) - a(15) - a(16) - a(23) - a(24) - a(25): If a(5) < m1 Or a(5) > m2 Then GoTo 350
a(4) = s1 - a(5) - a(6) - a(13) - a(14) - a(15) - a(22) - a(23) - a(24): If a(4) < m1 Or a(4) > m2 Then GoTo 350
a(3) = s1 - a(4) - a(5) - a(12) - a(13) - a(14) - a(21) - a(22) - a(23): If a(3) < m1 Or a(3) > m2 Then GoTo 350
a(2) = s1 - a(3) - a(4) - a(11) - a(12) - a(13) - a(20) - a(21) - a(22): If a(2) < m1 Or a(2) > m2 Then GoTo 350
a(1) = s1 - a(2) - a(3) - a(10) - a(11) - a(12) - a(19) - a(20) - a(21): If a(1) < m1 Or a(1) > m2 Then GoTo 350
' Exclude solutions with more than 3 times 0, 1 and 2
' in rows, columns, diagonals and sub squares (partly compact only)
GoSub 1800: If fl1 = 0 Then GoTo 350
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers)
350 Next j35
360 Next j36
440 Next j44
450 Next j45
530 Next j53
540 Next j54
620 Next j62
630 Next j63
650 Next j65
660 Next j66
670 Next j67
680 Next j68
690 Next j69
700 Next j70
710 Next j71
720 Next j72
740 Next j74
750 Next j75
760 Next j76
770 Next j77
780 Next j78
790 Next j79
800 Next j80
810 Next j81
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine Ternary9")
End
' Exclude solutions with more than 3 times 0, 1 and 2
' in rows, columns, diagonals and sub squares (partly compact only)
1800 fl1 = 1
' Rows
i1 = -8
For i0 = 1 To 9
i1 = i1 + 9
b(1) = a(i1): b(2) = a(i1 + 1): b(3) = a(i1 + 2): b(4) = a(i1 + 3): b(5) = a(i1 + 4)
b(6) = a(i1 + 5): b(7) = a(i1 + 6): b(8) = a(i1 + 7): b(9) = a(i1 + 8)
GoSub 1860: If fl1 = 0 Then Return
Next i0
' Columns
i1 = 0
For i0 = 1 To 9
i1 = i1 + 1
b(1) = a(i1): b(2) = a(i1 + 9): b(3) = a(i1 + 18): b(4) = a(i1 + 27): b(5) = a(i1 + 36)
b(6) = a(i1 + 45): b(7) = a(i1 + 54): b(8) = a(i1 + 63): b(9) = a(i1 + 72)
GoSub 1860: If fl1 = 0 Then Return
Next i0
' Main Diagonals
b(1) = a(1): b(2) = a(11): b(3) = a(21): b(4) = a(31): b(5) = a(41): b(6) = a(51): b(7) = a(61): b(8) = a(71): b(9) = a(81):
GoSub 1860: If fl1 = 0 Then Return
b(1) = a(9): b(2) = a(17): b(3) = a(25): b(4) = a(33): b(5) = a(41): b(6) = a(49): b(7) = a(57): b(8) = a(65): b(9) = a(73):
GoSub 1860: If fl1 = 0 Then Return
' Sub Squares 3 x 3 (left to right)
For i1 = 1 To 3 'Check 27 Squares
i22 = (i1 - 1) * 27
For i2 = 1 To 9
i11 = i2:
i12 = (i11 + 1) Mod 9: If i12 = 0 Then i12 = 9
i13 = (i12 + 1) Mod 9: If i13 = 0 Then i13 = 9
b(1) = a(i22 + i11): b(2) = a(i22 + i12): b(3) = a(i22 + i13)
b(4) = a(i22 + i11 + 9): b(5) = a(i22 + i12 + 9): b(6) = a(i22 + i13 + 9)
b(7) = a(i22 + i11 + 18): b(8) = a(i22 + i12 + 18): b(9) = a(i22 + i13 + 18)
GoSub 1860: If fl1 = 0 Then Return
Next i2
Next i1
For i1 = 1 To 5 'Check 12 Squares
If i1 <> 3 Then
i22 = 9 + (i1 - 1) * 9
For i2 = 1 To 9 Step 3
i11 = i2
i12 = (i11 + 1) Mod 9: If i12 = 0 Then i12 = 9
i13 = (i12 + 1) Mod 9: If i13 = 0 Then i13 = 9
b(1) = a(i22 + i11): b(2) = a(i22 + i12): b(3) = a(i22 + i13)
b(4) = a(i22 + i11 + 9): b(5) = a(i22 + i12 + 9): b(6) = a(i22 + i13 + 9)
b(7) = a(i22 + i11 + 18): b(8) = a(i22 + i12 + 18): b(9) = a(i22 + i13 + 18)
GoSub 1860: If fl1 = 0 Then Return
Next i2
End If
Next i1
' Check 6 Squares
b(1) = a(64): b(2) = a(65): b(3) = a(66): b(4) = a(73): b(5) = a(74): b(6) = a(75): b(7) = a(1): b(8) = a(2): b(9) = a(3):
GoSub 1860: If fl1 = 0 Then Return
b(1) = a(67): b(2) = a(68): b(3) = a(69): b(4) = a(76): b(5) = a(77): b(6) = a(78): b(7) = a(4): b(8) = a(5): b(9) = a(6):
GoSub 1860: If fl1 = 0 Then Return
b(1) = a(70): b(2) = a(71): b(3) = a(72): b(4) = a(79): b(5) = a(80): b(6) = a(81): b(7) = a(7): b(8) = a(8): b(9) = a(9):
GoSub 1860: If fl1 = 0 Then Return
b(1) = a(73): b(2) = a(74): b(3) = a(75): b(4) = a(1): b(5) = a(2): b(6) = a(3): b(7) = a(10): b(8) = a(11): b(9) = a(12):
GoSub 1860: If fl1 = 0 Then Return
b(1) = a(76): b(2) = a(77): b(3) = a(78): b(4) = a(4): b(5) = a(5): b(6) = a(6): b(7) = a(13): b(8) = a(14): b(9) = a(15):
GoSub 1860: If fl1 = 0 Then Return
b(1) = a(79): b(2) = a(80): b(3) = a(81): b(4) = a(7): b(5) = a(8): b(6) = a(9): b(7) = a(16): b(8) = a(17): b(9) = a(18):
GoSub 1860: If fl1 = 0 Then Return
Return
' Count 0, 1 , 2
1860 fl1 = 1
Erase s9
For j1 = 1 To 9
j2 = b(j1): s9(j2) = s9(j2) + 1
If s9(j2) > 3 Then fl1 = 0: Return
Next j1
Return
' Print results (selected numbers)
2645 For i1 = 1 To 81
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 81).Select
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 10: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 10
End If
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(n9)
i3 = 0
For i1 = 1 To 9
For i2 = 1 To 9
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
End Sub
