|
|
About the Author |
' Composes Non Latin Orthogonal Frames Order 9
' Based on Sets of Magic Rectangles (2 x 6)
' Tested with Office 2007 under Windows 7Sub CompLat9d() Dim a(81), a1(12), a2(12) y = MsgBox("Locked", vbCritical, "Routine CompLat9d") End n2 = 0: n9 = 0: k1 = 1: k2 = 1 ' Order 3 Semi Magic Corner Square a(1) = 45: a(2) = 5: a(3) = 73: a(10) = 77: a(11) = 37: a(12) = 9: a(19) = 1: a(20) = 81: a(21) = 41: ' Rectangles (2 x 6) For j100 = 2 To 34 ' Read Rectangles For i1 = 1 To 12 a1(i1) = Sheets("LnsRct26").Cells(j100, i1).Value a2(i1) = Sheets("LnsRct26").Cells(j100, i1 + 12).Value Next i1 ' Compose Frames a(4) = a2(1): a(5) = a2(2): a(6) = a2(3): a(7) = a2(4): a(8) = a2(5): a(9) = a2(6): a(13) = a2(7): a(14) = a2(8): a(15) = a2(9): a(16) = a2(10): a(17) = a2(11): a(18) = a2(12): a(28) = a1(1): a(29) = a1(7): a(37) = a1(2): a(38) = a1(8): a(46) = a1(3): a(47) = a1(9): a(55) = a1(4): a(56) = a1(10): a(64) = a1(5): a(65) = a1(11): a(73) = a1(6): a(74) = a1(12): GoSub 1800: If fl1 = 0 Then GoTo 5 n9 = n9 + 1 GoSub 2650 'Print results (squares) 5 Next j100 End ' Exclude solutions with identical numbers Latin Lines Order 9 1800 fl1 = 1 For j1 = 1 To 9 a20 = a(j1): If a20 = 0 Then GoTo 1810 For j2 = (1 + j1) To 9 If a20 = a(j2) Then fl1 = 0: Return Next j2 1810 Next j1 Return ' Print results (squares) 2650 n2 = n2 + 1 If n2 = 4 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
' Generates Sets Magic Rectangles (2 x 6)
' Tested with Office 2007 under Windows 7Sub MgcRect26() Dim a1(81), a(36), b1(81), b(81), C(36), a9(81) y = MsgBox("Locked", vbCritical, "Routine MgcRect26") End n2 = 0: n3 = 0: n9 = 0: n10 = 0: k1 = 1: k2 = 1 Sheets("Klad1").Select t1 = Timer ' Define variables a1(1) = 2: a1(2) = 3: a1(3) = 4: a1(4) = 6: a1(5) = 7: a1(6) = 8: a1(7) = 10: a1(8) = 18: a1(9) = 19: a1(10) = 27: a1(11) = 28: a1(12) = 36: a1(13) = 46: a1(14) = 54: a1(15) = 55: a1(16) = 63: a1(17) = 64: a1(18) = 72: a1(19) = 74: a1(20) = 75: a1(21) = 76: a1(22) = 78: a1(23) = 79: a1(24) = 80: For i1 = 1 To 24 b1(a1(i1)) = a1(i1) Next i1 m1 = 1: m2 = 24: s1 = 246 ' Generate Squares For j36 = m1 To m2 'a(36) If b(a1(j36)) = 0 Then b(a1(j36)) = a1(j36): C(36) = a1(j36) Else GoTo 360 a(36) = a1(j36) a(30) = s1 / 3 - a(36): If b(a(30)) = 0 Then b(a(30)) = a(30): C(30) = a(30) Else GoTo 300 For j35 = j36 + 1 To m2 'a(35) If b(a1(j35)) = 0 Then b(a1(j35)) = a1(j35): C(35) = a1(j35) Else GoTo 350 a(35) = a1(j35) a(29) = s1 / 3 - a(35): If b(a(29)) = 0 Then b(a(29)) = a(29): C(29) = a(29) Else GoTo 290 For j34 = j35 + 1 To m2 'a(34) If b(a1(j34)) = 0 Then b(a1(j34)) = a1(j34): C(34) = a1(j34) Else GoTo 340 a(34) = a1(j34) a(28) = s1 / 3 - a(34): If b(a(28)) = 0 Then b(a(28)) = a(28): C(28) = a(28) Else GoTo 280 For j33 = j34 + 1 To m2 'a(33) If b(a1(j33)) = 0 Then b(a1(j33)) = a1(j33): C(33) = a1(j33) Else GoTo 330 a(33) = a1(j33) a(27) = s1 / 3 - a(33): If b(a(27)) = 0 Then b(a(27)) = a(27): C(27) = a(27) Else GoTo 270 For j32 = j33 + 1 To m2 'a(32) If b(a1(j32)) = 0 Then b(a1(j32)) = a1(j32): C(32) = a1(j32) Else GoTo 320 a(32) = a1(j32) a(31) = s1 - a(32) - a(33) - a(34) - a(35) - a(36) If a(31) < a1(m1) Or a(31) > a1(m2) Then GoTo 310 If a(31) < a(32) Then GoTo 310 If a(31) > a(30) Then GoTo 310 If b1(a(31)) = 0 Then GoTo 310 If b(a(31)) = 0 Then b(a(31)) = a(31): C(31) = a(31) Else GoTo 310 a(26) = s1 / 3 - a(32): If b(a(26)) = 0 Then b(a(26)) = a(26): C(26) = a(26) Else GoTo 260 a(25) = s1 / 3 - a(31): If b(a(25)) = 0 Then b(a(25)) = a(25): C(25) = a(25) Else GoTo 250 For j24 = m1 To m2 'a(24) If b(a1(j24)) = 0 Then b(a1(j24)) = a1(j24): C(24) = a1(j24) Else GoTo 240 a(24) = a1(j24) a(18) = s1 / 3 - a(24): If b(a(18)) = 0 Then b(a(18)) = a(18): C(18) = a(18) Else GoTo 180 For j23 = j24 + 1 To m2 'a(23) If b(a1(j23)) = 0 Then b(a1(j23)) = a1(j23): C(23) = a1(j23) Else GoTo 218 a(23) = a1(j23) a(17) = s1 / 3 - a(23): If b(a(17)) = 0 Then b(a(17)) = a(17): C(17) = a(17) Else GoTo 170 For j22 = j23 + 1 To m2 'a(22) If b(a1(j22)) = 0 Then b(a1(j22)) = a1(j22): C(22) = a1(j22) Else GoTo 220 a(22) = a1(j22) a(16) = s1 / 3 - a(22): If b(a(16)) = 0 Then b(a(16)) = a(16): C(16) = a(16) Else GoTo 160 For j21 = j22 + 1 To m2 'a(21) If b(a1(j21)) = 0 Then b(a1(j21)) = a1(j21): C(21) = a1(j21) Else GoTo 210 a(21) = a1(j21) a(15) = s1 / 3 - a(21): If b(a(15)) = 0 Then b(a(15)) = a(15): C(15) = a(15) Else GoTo 150 For j20 = j21 + 1 To m2 'a(20) If b(a1(j20)) = 0 Then b(a1(j20)) = a1(j20): C(20) = a1(j20) Else GoTo 200 a(20) = a1(j20) a(19) = s1 - a(20) - a(21) - a(22) - a(23) - a(24) If a(19) < a1(m1) Or a(19) > a1(m2) Then GoTo 190 If a(19) < a(20) Then GoTo 190 If a(19) > a(18) Then GoTo 190 If b1(a(19)) = 0 Then GoTo 190 If b(a(19)) = 0 Then b(a(19)) = a(19): C(19) = a(19) Else GoTo 190 a(14) = s1 / 3 - a(20): If b(a(14)) = 0 Then b(a(14)) = a(14): C(14) = a(14) Else GoTo 140 a(13) = s1 / 3 - a(19): If b(a(13)) = 0 Then b(a(13)) = a(13): C(13) = a(13) Else GoTo 130 n9 = n9 + 1 ' GoSub 2650 'Print results (squares) GoSub 2645 'Print results (selected numbers) ' Cells(1, 1).Value = n9 'Counting ''End b(C(13)) = 0: C(13) = 0 130 b(C(14)) = 0: C(14) = 0 140 b(C(19)) = 0: C(19) = 0 190 b(C(20)) = 0: C(20) = 0 200 Next j20 b(C(15)) = 0: C(15) = 0 150 b(C(21)) = 0: C(21) = 0 210 Next j21 b(C(16)) = 0: C(16) = 0 160 b(C(22)) = 0: C(22) = 0 220 Next j22 b(C(17)) = 0: C(17) = 0 170 b(C(23)) = 0: C(23) = 0 218 Next j23 b(C(18)) = 0: C(18) = 0 180 b(C(24)) = 0: C(24) = 0 240 Next j24 b(C(25)) = 0: C(25) = 0 250 b(C(26)) = 0: C(26) = 0 260 b(C(31)) = 0: C(31) = 0 310 b(C(32)) = 0: C(32) = 0 320 Next j32 b(C(27)) = 0: C(27) = 0 270 b(C(33)) = 0: C(33) = 0 330 Next j33 b(C(28)) = 0: C(28) = 0 280 b(C(34)) = 0: C(34) = 0 340 Next j34 b(C(29)) = 0: C(29) = 0 290 b(C(35)) = 0: C(35) = 0 350 Next j35 b(C(30)) = 0: C(30) = 0 300 b(C(36)) = 0: C(36) = 0 360 Next j36 500 t2 = Timer t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1) y = MsgBox(t10, 0, "Routine MgcRect26") End Return ' Print results (selected numbers) 2645 For i1 = 1 To 36 Cells(n9, i1).Value = a(i1) Next i1 Cells(n9, 37).Value = n9 Return ' Print results (squares) 2650 n2 = n2 + 1 If n2 = 5 Then n2 = 1: k1 = k1 + 7: k2 = 1 Else If n9 > 1 Then k2 = k2 + 7 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 6 For i2 = 1 To 6 i3 = i3 + 1 Cells(k1 + i1, k2 + i2).Value = a(i3) Next i2 Next i1 Return End Sub
|
|
About the Author |