Vorige Pagina About the Author

' 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

Vorige Pagina About the Author