Vorige Pagina About the Author

' Generates Latin Top Rows for order 13 Quadrant P34 Latin Pan Magic Squares
' Latin Squares L2 / R2 (Example 1)

' Tested with Office 365 under Windows 10 

Sub LatRowP34c()

Dim a(13)

y = MsgBox("Blocked", 0, "LatRowP34c")
End

For j13 = 1 To 13
a(13) = j13 - 1

For j12 = 1 To 13
a(12) = j12 - 1

a(11) = 2 * a(12) - a(13)
If a(11) < 0 Or a(11) > 12 Then GoTo 120

a(7) = 0.3 * a(11) - 1.1 * a(12) + 1.8 * a(13)
If a(7) < 0 Or a(7) > 12 Or CInt(a(7)) <> a(7) Then GoTo 120

a(6) = 0.1 * a(11) + 0.3 * a(12) + 0.6 * a(13)
If a(6) < 0 Or a(6) > 12 Or CInt(a(6)) <> a(6) Then GoTo 120

a(5) = 0.3 * a(11) + 0.9 * a(12) - 0.2 * a(13)
If a(5) < 0 Or a(5) > 12 Or CInt(a(5)) <> a(5) Then GoTo 120

a(1) = 0.4 * a(11) - 1.8 * a(12) + 2.4 * a(13)
If a(1) < 0 Or a(1) > 12 Or CInt(a(1)) <> a(1) Then GoTo 120

For j10 = 1 To 13
a(10) = j10 - 1

For j9 = 1 To 13
a(9) = j9 - 1

a(8) = a(9) + 0.6 * a(11) - 0.2 * a(12) - 0.4 * a(13)
If a(8) < 0 Or a(8) > 12 Or CInt(a(8)) <> a(8) Then GoTo 90

a(2) = a(9) + 0.1 * a(11) + 0.3 * a(12) - 0.4 * a(13)
If a(2) < 0 Or a(2) > 12 Or CInt(a(2)) <> a(2) Then GoTo 90

For j4 = 1 To 13
a(4) = j4 - 1

a(3) = 78 - a(4) - 3 * a(9) - a(10) - 3 * a(11) + a(12) - 5 * a(13)
If a(3) < 0 Or a(3) > 12 Then GoTo 40

    'Check Line
    
    For i1 = 1 To 13
        a2 = a(i1)
        For i2 = i1 + 1 To 13
            If a(i2) = a2 Then GoTo 40
        Next i2
    Next i1
    
    'Print Line
    
    n9 = n9 + 1
    For i1 = 1 To 13
        Cells(n9, i1).Value = a(i1)
    Next i1
    Cells(n9, 14).Value = n9
    Cells(1, 16).Value = n9

40 Next j4

90 Next j9
100 Next j10

120 Next j12
130 Next j13

End Sub

' Generates Latin Top Rows for order 13 Quadrant P34 Latin Pan Magic Squares
' Latin Squares A(L2)

' Tested with Office 365 under Windows 10 

Sub LatRowP34a()

y = MsgBox("Blocked", 0, "LatRowP34a")
End

For j13 = 1 To 13
a(13) = j13 - 1

For j12 = 1 To 13
a(12) = j12 - 1

If a(12) = a(13) Then GoTo 120

For j11 = 1 To 13
a(11) = j11 - 1

If a(11) = a(12) Or a(11) = a(13) Then GoTo 110

For j10 = 1 To 13
a(10) = j10 - 1

If a(10) = a(11) Or a(10) = a(12) Or a(10) = a(13) Then GoTo 100

For j9 = 1 To 13
a(9) = j9 - 1

If a(9) = a(10) Or a(9) = a(11) Or a(9) = a(12) Or a(9) = a(13) Then GoTo 90

For j8 = 1 To 13
a(8) = j8 - 1

If a(8) = a(9) Or a(8) = a(10) Or a(8) = a(11) Or a(8) = a(12) Or a(8) = a(13) Then GoTo 80

For j7 = 1 To 13
a(7) = j7 - 1

If a(7) = a(9) Or a(7) = a(10) Or a(7) = a(11) Or a(7) = a(12) Or a(7) = a(13) Then GoTo 70
If a(7) = a(8) Then GoTo 70

a(6) = (2 * a(7) - a(11) + 4 * a(12) - 3 * a(13)) / 2
If a(6) < 0 Or a(6) > 12 Or CInt(a(6)) <> a(6) Then GoTo 70
If a(6) = a(9) Or a(6) = a(10) Or a(6) = a(11) Or a(6) = a(12) Or a(6) = a(13) Then GoTo 70
If a(6) = a(7) Or a(6) = a(8) Then GoTo 70

a(5) = a(7) + 2 * a(12) - 2 * a(13)
If a(5) < 0 Or a(5) > 12 Then GoTo 70
If a(5) = a(9) Or a(5) = a(10) Or a(5) = a(11) Or a(5) = a(12) Or a(5) = a(13) Then GoTo 70
If a(5) = a(6) Or a(5) = a(7) Or a(5) = a(8) Then GoTo 70

a(1) = -2 * a(6) + 2 * a(7) + a(12)
If a(1) < 0 Or a(1) > 12 Then GoTo 70
If a(1) = a(9) Or a(1) = a(10) Or a(1) = a(11) Or a(1) = a(12) Or a(1) = a(13) Then GoTo 70
If a(1) = a(5) Or a(1) = a(6) Or a(1) = a(7) Or a(1) = a(8) Then GoTo 70

For j4 = 1 To 13
a(4) = j4 - 1

For j3 = 1 To 13
a(3) = j3 - 1

a(2) = 78 - a(3) - a(4) - a(5) + 2 * a(6) - 4 * a(7) - a(8) - a(9) - a(10) - a(11) - 3 * a(12)
If a(2) < 0 Or a(2) > 12 Then GoTo 30

    'Check Line
    
    For i1 = 1 To 13
        a2 = a(i1)
        For i2 = i1 + 1 To 13
            If a(i2) = a2 Then GoTo 30
        Next i2
    Next i1
    
    'Print Line
    
    n9 = n9 + 1
''    For i1 = 1 To 13
''        Cells(n9, i1).Value = a(i1)
''    Next i1
''    Cells(n9, 14).Value = n9
    Cells(1, 16).Value = n9

''End

30 Next j3
40 Next j4

70 Next j7
80 Next j8
90 Next j9
100 Next j10
110 Next j11
120 Next j12
130 Next j13

End Sub

' Generates Latin Top Rows for order 13 Quadrant P34 Latin Pan Magic Squares
' Latin Squares B(R6)

' Tested with Office 365 under Windows 10 

Sub LatRowP34b()

Dim b(13)

y = MsgBox("Blocked", 0, "LatRowP34b")
End

For j13 = 1 To 13
b(13) = j13 - 1

For j12 = 1 To 13
b(12) = j12 - 1

If b(12) = b(13) Then GoTo 120

For j11 = 1 To 13
b(11) = j11 - 1

If b(11) = b(12) Or b(11) = b(13) Then GoTo 110

For j10 = 1 To 13
b(10) = j10 - 1

If b(10) = b(11) Or b(10) = b(12) Or b(10) = b(13) Then GoTo 100

For j9 = 1 To 13
b(9) = j9 - 1

If b(9) = b(10) Or b(9) = b(11) Or b(9) = b(12) Or b(9) = b(13) Then GoTo 90

For j8 = 1 To 13
b(8) = j8 - 1

If b(8) = b(9) Or b(8) = b(10) Or b(8) = b(11) Or b(8) = b(12) Or b(8) = b(13) Then GoTo 80

For j7 = 1 To 13
b(7) = j7 - 1

If b(7) = b(9) Or b(7) = b(10) Or b(7) = b(11) Or b(7) = b(12) Or b(7) = b(13) Then GoTo 70
If b(7) = b(8) Then GoTo 70

For j6 = 1 To 13
b(6) = j6 - 1

If b(6) = b(9) Or b(6) = b(10) Or b(6) = b(11) Or b(6) = b(12) Or b(6) = b(13) Then GoTo 60
If b(6) = b(7) Or b(6) = b(8) Then GoTo 60

For j5 = 1 To 13
b(5) = j5 - 1

If b(5) = b(9) Or b(5) = b(10) Or b(5) = b(11) Or b(5) = b(12) Or b(5) = b(13) Then GoTo 50
If b(5) = b(6) Or b(5) = b(7) Or b(5) = b(8) Then GoTo 50


b(4) = 0.5 * b(6) + 1.5 * b(7) + b(10) - 2 * b(13)
If b(4) < 0 Or b(4) > 12 Or CInt(b(4)) <> b(4) Then GoTo 50

b(3) = 0.5 * b(6) - 0.5 * b(7) + b(10)
If b(3) < 0 Or b(3) > 12 Or CInt(b(3)) <> b(3) Then GoTo 50

b(2) = 78 - b(5) - 3.5 * b(6) - 5.5 * b(7) - b(8) - b(9) - 3 * b(10) - b(11) - b(12) + 5 * b(13)
If b(2) < 0 Or b(2) > 12 Or CInt(b(2)) <> b(2) Then GoTo 50

b(1) = b(6) + 3 * b(7) - 3 * b(13)
If b(1) < 0 Or b(1) > 12 Or CInt(b(1)) <> b(1) Then GoTo 50


    'Check Line
    
    For i1 = 1 To 13
        b2 = b(i1)
        For i2 = i1 + 1 To 13
            If b(i2) = b2 Then GoTo 50
        Next i2
    Next i1
    
    'Print Line
    
    n9 = n9 + 1
''    For i1 = 1 To 13
''        Cells(n9, i1).Value = b(i1)
''    Next i1
''    Cells(n9, 14).Value = n9
    Cells(1, 16).Value = n9

''End

50 Next j5
60 Next j6
70 Next j7
80 Next j8
90 Next j9
100 Next j10
110 Next j11
120 Next j12
130 Next j13

End Sub
Vorige Pagina About the Author