' Combines Latin Cubes into Simple Magic Cubes (Prime Numbers)
' Tested with Office 365 under Windows 10
Sub CnstrCbs4b()
Dim b(3, 64), a(64), c(4), s2(4), s(12, 10)
Dim a1(4), a2(4), a3(4)
Sheets("Klad1").Select
y = MsgBox("Locked", vbCritical, "Routine CnstrCbs4b")
End
ShtNm1 = "LtnCbs4a": n4 = 96 'Hor Magic Planes
'' ShtNm1 = "LtnCbs4c": n4 = 8610 'Semi Magic Planes
'' ShtNm1 = "SudCbs4": n4 = 48 'Almost Perfect
ShtNm2 = "CrltLns4" 'Correlated Magic Lines
n2 = 0: n9 = 0: k1 = 1: k2 = 1
t1 = Timer
For j40 = 2 To 2 ''9 'Select Correlated Magic Line
For i1 = 1 To 4
a1(i1) = Sheets(ShtNm2).Cells(j40, i1).Value
a2(i1) = Sheets(ShtNm2).Cells(j40, i1 + 5).Value
a3(i1) = Sheets(ShtNm2).Cells(j40, i1 + 10).Value
Next i1
s1 = Sheets(ShtNm2).Cells(j40, 16).Value
For j1 = 1 To n4
For j2 = 1 To n4
If j2 = j1 Then GoTo 20
For j3 = 1 To n4
If j3 = j1 Or j3 = j2 Then GoTo 30
j10 = j1: j20 = 1: GoSub 100 'Read Latin Cube 1
j10 = j2: j20 = 2: GoSub 100 'Read Latin Cube 2
j10 = j3: j20 = 3: GoSub 100 'Read Latin Cube 3
For j4 = 1 To 64
i1 = b(1, j4) + 1:
i2 = b(2, j4) + 1:
i3 = b(3, j4) + 1:
a(j4) = a1(i1) + a2(i2) + a3(i3)
Next j4
GoSub 200: If fl1 = 0 Then GoTo 30 'Check Magic Sum
GoSub 300: If fl1 = 0 Then GoTo 30 'Ckeck identical numbers
' n9 = n9 + 1: GoSub 740 'Print results (selected numbers)
n9 = n9 + 1: GoSub 750 'Print results (planes 1, 2, 3, 4)
' n9 = n9 + 1: GoSub 760 'Print results (3d)
' n9 = n9 + 1: Cells(1, 1).Value = n9 'Counting
30 Next j3
20 Next j2
10 Next j1
40 Next j40
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine CnstrCbs4b")
End
' Read Latin Cubes
100 i3 = 0
k11 = Int((j10 - 1) / 8)
k12 = j10 - k11 * 8
k21 = 2 + k11 * 20
k22 = 2 + (k12 - 1) * 5
For i0 = 1 To 4
i3 = (4 - i0) * 16
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
b(j20, i3) = Sheets(ShtNm1).Cells(k21 - 1 + i1 + (i0 - 1) * 5, k22 - 1 + i2).Value 'load cube
Next i2
Next i1
Next i0
Return
' Check Magic Sum
200 fl1 = 1
' Plane 11 (Top) Plane 21 (Left) Plane 31 (Back)
s(1, 1) = a(49) + a(50) + a(51) + a(52): s(5, 1) = a(61) + a(57) + a(53) + a(49): s(9, 1) = a(49) + a(50) + a(51) + a(52)
s(1, 2) = a(53) + a(54) + a(55) + a(56): s(5, 2) = a(45) + a(41) + a(37) + a(33): s(9, 2) = a(33) + a(34) + a(35) + a(36)
s(1, 3) = a(57) + a(58) + a(59) + a(60): s(5, 3) = a(29) + a(25) + a(21) + a(17): s(9, 3) = a(17) + a(18) + a(19) + a(20)
s(1, 4) = a(61) + a(62) + a(63) + a(64): s(5, 4) = a(13) + a(9) + a(5) + a(1): s(9, 4) = a(1) + a(2) + a(3) + a(4)
s(1, 5) = a(49) + a(53) + a(57) + a(61): s(5, 5) = a(61) + a(45) + a(29) + a(13): s(9, 5) = a(49) + a(33) + a(17) + a(1)
s(1, 6) = a(50) + a(54) + a(58) + a(62): s(5, 6) = a(57) + a(41) + a(25) + a(9): s(9, 6) = a(50) + a(34) + a(18) + a(2)
s(1, 7) = a(51) + a(55) + a(59) + a(63): s(5, 7) = a(53) + a(37) + a(21) + a(5): s(9, 7) = a(51) + a(35) + a(19) + a(3)
s(1, 8) = a(52) + a(56) + a(60) + a(64): s(5, 8) = a(49) + a(33) + a(17) + a(1): s(9, 8) = a(52) + a(36) + a(20) + a(4)
s(1, 9) = a(49) + a(54) + a(59) + a(64): s(5, 9) = a(61) + a(41) + a(21) + a(1): s(9, 9) = a(49) + a(34) + a(19) + a(4)
s(1, 10) = a(52) + a(55) + a(58) + a(61): s(5, 10) = a(49) + a(37) + a(25) + a(13): s(9, 10) = a(52) + a(35) + a(18) + a(1)
' Plane 12 Plane 22 Plane 32
s(2, 1) = a(33) + a(34) + a(35) + a(36): s(6, 1) = a(62) + a(58) + a(54) + a(50): s(10, 1) = a(53) + a(54) + a(55) + a(56)
s(2, 2) = a(37) + a(38) + a(39) + a(40): s(6, 2) = a(46) + a(42) + a(38) + a(34): s(10, 2) = a(37) + a(38) + a(39) + a(40)
s(2, 3) = a(41) + a(42) + a(43) + a(44): s(6, 3) = a(30) + a(26) + a(22) + a(18): s(10, 3) = a(21) + a(22) + a(23) + a(24)
s(2, 4) = a(45) + a(46) + a(47) + a(48): s(6, 4) = a(14) + a(10) + a(6) + a(2): s(10, 4) = a(5) + a(6) + a(7) + a(8)
s(2, 5) = a(33) + a(37) + a(41) + a(45): s(6, 5) = a(62) + a(46) + a(30) + a(14): s(10, 5) = a(53) + a(37) + a(21) + a(5)
s(2, 6) = a(34) + a(38) + a(42) + a(46): s(6, 6) = a(58) + a(42) + a(26) + a(10): s(10, 6) = a(54) + a(38) + a(22) + a(6)
s(2, 7) = a(35) + a(39) + a(43) + a(47): s(6, 7) = a(54) + a(38) + a(22) + a(6): s(10, 7) = a(55) + a(39) + a(23) + a(7)
s(2, 8) = a(36) + a(40) + a(44) + a(48): s(6, 8) = a(50) + a(34) + a(18) + a(2): s(10, 8) = a(56) + a(40) + a(24) + a(8)
s(2, 9) = a(33) + a(38) + a(43) + a(48): s(6, 9) = a(62) + a(42) + a(22) + a(2): s(10, 9) = a(53) + a(38) + a(23) + a(8)
s(2, 10) = a(36) + a(39) + a(42) + a(45): s(6, 10) = a(50) + a(38) + a(26) + a(14): s(10, 10) = a(56) + a(39) + a(22) + a(5)
' Plane 13 Plane 23 Plane 33
s(3, 1) = a(17) + a(18) + a(19) + a(20): s(7, 1) = a(63) + a(59) + a(55) + a(51): s(11, 1) = a(57) + a(58) + a(59) + a(60)
s(3, 2) = a(21) + a(22) + a(23) + a(24): s(7, 2) = a(47) + a(43) + a(39) + a(35): s(11, 2) = a(41) + a(42) + a(43) + a(44)
s(3, 3) = a(25) + a(26) + a(27) + a(28): s(7, 3) = a(31) + a(27) + a(23) + a(19): s(11, 3) = a(25) + a(26) + a(27) + a(28)
s(3, 4) = a(29) + a(30) + a(31) + a(32): s(7, 4) = a(15) + a(11) + a(7) + a(3): s(11, 4) = a(9) + a(10) + a(11) + a(12)
s(3, 5) = a(17) + a(21) + a(25) + a(29): s(7, 5) = a(63) + a(47) + a(31) + a(15): s(11, 5) = a(57) + a(41) + a(25) + a(9)
s(3, 6) = a(18) + a(22) + a(26) + a(30): s(7, 6) = a(59) + a(43) + a(27) + a(11): s(11, 6) = a(58) + a(42) + a(26) + a(10)
s(3, 7) = a(19) + a(23) + a(27) + a(31): s(7, 7) = a(55) + a(39) + a(23) + a(7): s(11, 7) = a(59) + a(43) + a(27) + a(11)
s(3, 8) = a(20) + a(24) + a(28) + a(32): s(7, 8) = a(51) + a(35) + a(19) + a(3): s(11, 8) = a(60) + a(44) + a(28) + a(12)
s(3, 9) = a(17) + a(22) + a(27) + a(32): s(7, 9) = a(63) + a(43) + a(23) + a(3): s(11, 9) = a(57) + a(42) + a(27) + a(12)
s(3, 10) = a(20) + a(23) + a(26) + a(29): s(7, 10) = a(51) + a(39) + a(27) + a(15): s(11, 10) = a(60) + a(43) + a(26) + a(9)
' Plane 14 Plane 24 Plane 34
s(4, 1) = a(1) + a(2) + a(3) + a(4): s(8, 1) = a(64) + a(60) + a(56) + a(52): s(12, 1) = a(61) + a(62) + a(63) + a(64)
s(4, 2) = a(5) + a(6) + a(7) + a(8): s(8, 2) = a(48) + a(44) + a(40) + a(36): s(12, 2) = a(45) + a(46) + a(47) + a(48)
s(4, 3) = a(9) + a(10) + a(11) + a(12): s(8, 3) = a(32) + a(28) + a(24) + a(20): s(12, 3) = a(29) + a(30) + a(31) + a(32)
s(4, 4) = a(13) + a(14) + a(15) + a(16): s(8, 4) = a(16) + a(12) + a(8) + a(4): s(12, 4) = a(13) + a(14) + a(15) + a(16)
s(4, 5) = a(1) + a(5) + a(9) + a(13): s(8, 5) = a(64) + a(48) + a(32) + a(16): s(12, 5) = a(61) + a(45) + a(29) + a(13)
s(4, 6) = a(2) + a(6) + a(10) + a(14): s(8, 6) = a(60) + a(44) + a(28) + a(12): s(12, 6) = a(62) + a(46) + a(30) + a(14)
s(4, 7) = a(3) + a(7) + a(11) + a(15): s(8, 7) = a(56) + a(40) + a(24) + a(8): s(12, 7) = a(63) + a(47) + a(31) + a(15)
s(4, 8) = a(4) + a(8) + a(12) + a(16): s(8, 8) = a(52) + a(36) + a(20) + a(4): s(12, 8) = a(64) + a(48) + a(32) + a(16)
s(4, 9) = a(1) + a(6) + a(11) + a(16): s(8, 9) = a(64) + a(44) + a(24) + a(4): s(12, 9) = a(61) + a(46) + a(31) + a(16)
s(4, 10) = a(4) + a(7) + a(10) + a(13): s(8, 10) = a(52) + a(40) + a(28) + a(16): s(12, 10) = a(64) + a(47) + a(30) + a(13)
' Space Diagonals
s2(1) = a(13) + a(26) + a(39) + a(52)
s2(2) = a(16) + a(27) + a(38) + a(49)
s2(3) = a(1) + a(22) + a(43) + a(64)
s2(4) = a(4) + a(23) + a(42) + a(61)
For i1 = 1 To 12
If i1 <= 4 Then m10 = 10 Else m10 = 8 'Hor Magic Planes
'' If i1 <= 8 Then m10 = 10 Else m10 = 8 'Hor and Vert (L/R) Magic Planes
'' m10 = 10 'Almost Perfect
'' m10 = 8 'Semi Magic Planes
For i2 = 1 To m10
If s(i1, i2) <> s1 Then fl1 = 0: Return
Next i2
Next i1
For i1 = 1 To 4
If s2(i1) <> s1 Then fl1 = 0: Return 'Disable for Almost Perfect
Next i1
Return
' Check identical numbers
300 fl1 = 1
For i1 = 1 To 64
a20 = a(i1)
For i2 = (1 + i1) To 64
If a20 = a(i2) Then fl1 = 0: Return
Next i2
Next i1
Return
' Print results (selected numbers)
740 Cells(n9, 1).Select
For i1 = 1 To 64
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (planes 11, 12, 13 and 14)
750 n2 = n2 + 1
If n2 = 9 Then
n2 = 1: k1 = k1 + 20: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 5
End If
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(n9)
For i0 = 1 To 4
i3 = (4 - i0) * 16
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 5, k2 + i2).Value = a(i3)
Next i2
Next i1
''Cells(k1 + (i0 - 1) * 5, k2 + 1).Value = "Plane 1" + CStr(i0)
Next i0
Return
' Print results (3d)
760 n2 = n2 + 1
If n2 = 3 Then
n2 = 1: k1 = k1 + 29: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 17
End If
For i0 = 1 To 4
i3 = (4 - i0) * 16
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
Cells(k1 + 1 + (i1 - 1) * 2 + (i0 - 1) * 7, k2 + 7 + (i2 - 1) * 3 - (i1 - 1) * 2).Value = a(i3)
Next i2
Next i1
Next i0
Return
End Sub
