Vorige Pagina About the Author

' Generates Most Perfect Magic Squares (Morris) of order 12, magic sum 870
' All Rows have Residuum Res12 = 72

' Tested with Office 365 under Windows 10

Sub MostPerf12()

Dim a(144), b(144), c(144)
Dim b12(12), Res12(26)

y = MsgBox("Locked", vbCritical, "Routine MostPerf12")
End

n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 1: m2 = 144: s1 = 870
r12 = 72

'   Generate data
    
    Sheets("Klad1").Select
    
m11 = 14: m12 = 107: m13 = 62: m14 = 95: m15 = 110: m16 = 11
    
    t1 = Timer

For j144 = m11 To m2 ''14 To 14                                               'a(144)
If b(j144) = 0 Then b(j144) = j144: c(144) = j144 Else GoTo 1440
a(144) = j144

For j143 = m12 To m2 ''107 To 107                                             'a(143)
If b(j143) = 0 Then b(j143) = j143: c(143) = j143 Else GoTo 1430
a(143) = j143

For j142 = m13 To m2 ''62 To 62                                               'a(142)
If b(j142) = 0 Then b(j142) = j142: c(142) = j142 Else GoTo 1420
a(142) = j142

For j141 = m14 To m2 ''95 To 95                                               'a(141)
If b(j141) = 0 Then b(j141) = j141: c(141) = j141 Else GoTo 1410
a(141) = j141

For j140 = m15 To m2 ''110 To 110                                             'a(140)
If b(j140) = 0 Then b(j140) = j140: c(140) = j140 Else GoTo 1400
a(140) = j140

For j139 = m16 To m2 ''11 To 11                                               'a(139)
If b(j139) = 0 Then b(j139) = j139: c(139) = j139 Else GoTo 1390
a(139) = j139

jj = 139
a(138) = (435 - a(139) + a(140) - a(141) + a(142) - a(143) - 2 * a(144)) / 3
j = 138: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(137) = 290 - a(138) - a(143) - a(144): j = 137: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(136) = 290 - a(137) - a(142) - a(143): j = 136: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(135) = 290 - a(136) - a(141) - a(142): j = 135: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(134) = 290 - a(135) - a(140) - a(141): j = 134: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(133) = 870 - a(134) - a(135) - a(136) - a(137) - a(138) - a(139) - a(140) - a(141) - a(142) - a(143) - a(144)
j = 133: GoSub 3000: If fl1 = 1 Then GoTo 1390

i10 = 12: GoSub 1500: If Res12(i10) <> r12 Then GoTo 1385

For j132 = m1 To m2 ''129                                             'a(132)
If b(j132) = 0 Then b(j132) = j132: c(132) = j132 Else GoTo 1320
a(132) = j132

jj = 132
a(131) = 290 - a(132) - a(143) - a(144): j = 131: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(130) = 290 - a(131) - a(142) - a(143): j = 130: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(129) = 290 - a(130) - a(141) - a(142): j = 129: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(128) = 290 - a(129) - a(140) - a(141): j = 128: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(127) = 290 - a(128) - a(139) - a(140): j = 127: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(126) = 290 - a(127) - a(138) - a(139): j = 126: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(125) = 290 - a(126) - a(137) - a(138): j = 125: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(124) = 290 - a(125) - a(136) - a(137): j = 124: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(123) = 290 - a(124) - a(135) - a(136): j = 123: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(122) = 290 - a(123) - a(134) - a(135): j = 122: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(121) = 290 - a(122) - a(133) - a(134): j = 121: GoSub 3000: If fl1 = 1 Then GoTo 1320

i10 = 11: GoSub 1500: If Res12(i10) <> r12 Then GoTo 1315

For j120 = m1 To m2 ''18                                              'a(120)
If b(j120) = 0 Then b(j120) = j120: c(120) = j120 Else GoTo 1200
a(120) = j120

jj = 120
a(119) = 290 - a(120) - a(131) - a(132): j = 119: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(118) = 290 - a(119) - a(130) - a(131): j = 118: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(117) = 290 - a(118) - a(129) - a(130): j = 117: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(116) = 290 - a(117) - a(128) - a(129): j = 116: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(115) = 290 - a(116) - a(127) - a(128): j = 115: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(114) = 290 - a(115) - a(126) - a(127): j = 114: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(113) = 290 - a(114) - a(125) - a(126): j = 113: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(112) = 290 - a(113) - a(124) - a(125): j = 112: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(111) = 290 - a(112) - a(123) - a(124): j = 111: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(110) = 290 - a(111) - a(122) - a(123): j = 110: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(109) = 290 - a(110) - a(121) - a(122): j = 109: GoSub 3000: If fl1 = 1 Then GoTo 1200

i10 = 10: GoSub 1500: If Res12(i10) <> r12 Then GoTo 1195

For j108 = m1 To m2 ''128                                            'a(108)
If b(j108) = 0 Then b(j108) = j108: c(108) = j108 Else GoTo 1080
a(108) = j108

jj = 108
a(107) = 290 - a(108) - a(119) - a(120): j = 107: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(106) = 290 - a(107) - a(118) - a(119): j = 106: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(105) = 290 - a(106) - a(117) - a(118): j = 105: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(104) = 290 - a(105) - a(116) - a(117): j = 104: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(103) = 290 - a(104) - a(115) - a(116): j = 103: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(102) = 290 - a(103) - a(114) - a(115): j = 102: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(101) = 290 - a(102) - a(113) - a(114): j = 101: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(100) = 290 - a(101) - a(112) - a(113): j = 100: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(99) = 290 - a(100) - a(111) - a(112): j = 99: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(98) = 290 - a(99) - a(110) - a(111): j = 98: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(97) = 290 - a(98) - a(109) - a(110): j = 97: GoSub 3000: If fl1 = 1 Then GoTo 1080

i10 = 9: GoSub 1500: If Res12(i10) <> r12 Then GoTo 1075

For j96 = m1 To m2 ''22                                               'a(96)
If b(j96) = 0 Then b(j96) = j96: c(96) = j96 Else GoTo 960
a(96) = j96

jj = 96
a(95) = 290 - a(96) - a(107) - a(108): j = 95: GoSub 3000: If fl1 = 1 Then GoTo 960
a(94) = 290 - a(95) - a(106) - a(107): j = 94: GoSub 3000: If fl1 = 1 Then GoTo 960
a(93) = 290 - a(94) - a(105) - a(106): j = 93: GoSub 3000: If fl1 = 1 Then GoTo 960
a(92) = 290 - a(93) - a(104) - a(105): j = 92: GoSub 3000: If fl1 = 1 Then GoTo 960
a(91) = 290 - a(92) - a(103) - a(104): j = 91: GoSub 3000: If fl1 = 1 Then GoTo 960
a(90) = 290 - a(91) - a(102) - a(103): j = 90: GoSub 3000: If fl1 = 1 Then GoTo 960
a(89) = 290 - a(90) - a(101) - a(102): j = 89: GoSub 3000: If fl1 = 1 Then GoTo 960
a(88) = 290 - a(89) - a(100) - a(101): j = 88: GoSub 3000: If fl1 = 1 Then GoTo 960
a(87) = 290 - a(88) - a(99) - a(100): j = 87: GoSub 3000: If fl1 = 1 Then GoTo 960
a(86) = 290 - a(87) - a(98) - a(99): j = 86: GoSub 3000: If fl1 = 1 Then GoTo 960
a(85) = 290 - a(86) - a(97) - a(98): j = 85: GoSub 3000: If fl1 = 1 Then GoTo 960

i10 = 8: GoSub 1500: If Res12(i10) <> r12 Then GoTo 955

a(84) = 435 + a(96) - a(108) + a(120) - a(132) - a(139) + a(140) - a(141) + a(142) - a(143) - 4 * a(144)
j = 84: GoSub 3000: If fl1 = 1 Then GoTo 960
a(83) = 290 - a(84) - a(95) - a(96): j = 83: GoSub 3000: If fl1 = 1 Then GoTo 960
a(82) = 290 - a(83) - a(94) - a(95): j = 82: GoSub 3000: If fl1 = 1 Then GoTo 960
a(81) = 290 - a(82) - a(93) - a(94): j = 81: GoSub 3000: If fl1 = 1 Then GoTo 960
a(80) = 290 - a(81) - a(92) - a(93): j = 80: GoSub 3000: If fl1 = 1 Then GoTo 960
a(79) = 290 - a(80) - a(91) - a(92): j = 79: GoSub 3000: If fl1 = 1 Then GoTo 960
a(78) = 290 - a(79) - a(90) - a(91): j = 78: GoSub 3000: If fl1 = 1 Then GoTo 960
a(77) = 290 - a(78) - a(89) - a(90): j = 77: GoSub 3000: If fl1 = 1 Then GoTo 960
a(76) = 290 - a(77) - a(88) - a(89): j = 76: GoSub 3000: If fl1 = 1 Then GoTo 960
a(75) = 290 - a(76) - a(87) - a(88): j = 75: GoSub 3000: If fl1 = 1 Then GoTo 960
a(74) = 290 - a(75) - a(86) - a(87): j = 74: GoSub 3000: If fl1 = 1 Then GoTo 960
a(73) = 290 - a(74) - a(85) - a(86): j = 73: GoSub 3000: If fl1 = 1 Then GoTo 960

i10 = 7: GoSub 1500: If Res12(i10) <> r12 Then GoTo 955

a(72) = 145 - a(138): j = 72: GoSub 3000: If fl1 = 1 Then GoTo 960
a(71) = 145 - a(137): j = 71: GoSub 3000: If fl1 = 1 Then GoTo 960
a(70) = 145 - a(136): j = 70: GoSub 3000: If fl1 = 1 Then GoTo 960
a(69) = 145 - a(135): j = 69: GoSub 3000: If fl1 = 1 Then GoTo 960
a(68) = 145 - a(134): j = 68: GoSub 3000: If fl1 = 1 Then GoTo 960
a(67) = 145 - a(133): j = 67: GoSub 3000: If fl1 = 1 Then GoTo 960
a(66) = 145 - a(144): j = 66: GoSub 3000: If fl1 = 1 Then GoTo 960
a(65) = 145 - a(143): j = 65: GoSub 3000: If fl1 = 1 Then GoTo 960
a(64) = 145 - a(142): j = 64: GoSub 3000: If fl1 = 1 Then GoTo 960
a(63) = 145 - a(141): j = 63: GoSub 3000: If fl1 = 1 Then GoTo 960
a(62) = 145 - a(140): j = 62: GoSub 3000: If fl1 = 1 Then GoTo 960
a(61) = 145 - a(139): j = 61: GoSub 3000: If fl1 = 1 Then GoTo 960
a(60) = 145 - a(126): j = 60: GoSub 3000: If fl1 = 1 Then GoTo 960
a(59) = 145 - a(125): j = 59: GoSub 3000: If fl1 = 1 Then GoTo 960
a(58) = 145 - a(124): j = 58: GoSub 3000: If fl1 = 1 Then GoTo 960
a(57) = 145 - a(123): j = 57: GoSub 3000: If fl1 = 1 Then GoTo 960
a(56) = 145 - a(122): j = 56: GoSub 3000: If fl1 = 1 Then GoTo 960
a(55) = 145 - a(121): j = 55: GoSub 3000: If fl1 = 1 Then GoTo 960
a(54) = 145 - a(132): j = 54: GoSub 3000: If fl1 = 1 Then GoTo 960
a(53) = 145 - a(131): j = 53: GoSub 3000: If fl1 = 1 Then GoTo 960
a(52) = 145 - a(130): j = 52: GoSub 3000: If fl1 = 1 Then GoTo 960
a(51) = 145 - a(129): j = 51: GoSub 3000: If fl1 = 1 Then GoTo 960
a(50) = 145 - a(128): j = 50: GoSub 3000: If fl1 = 1 Then GoTo 960
a(49) = 145 - a(127): j = 49: GoSub 3000: If fl1 = 1 Then GoTo 960
a(48) = 145 - a(114): j = 48: GoSub 3000: If fl1 = 1 Then GoTo 960
a(47) = 145 - a(113): j = 47: GoSub 3000: If fl1 = 1 Then GoTo 960
a(46) = 145 - a(112): j = 46: GoSub 3000: If fl1 = 1 Then GoTo 960
a(45) = 145 - a(111): j = 45: GoSub 3000: If fl1 = 1 Then GoTo 960
a(44) = 145 - a(110): j = 44: GoSub 3000: If fl1 = 1 Then GoTo 960
a(43) = 145 - a(109): j = 43: GoSub 3000: If fl1 = 1 Then GoTo 960
a(42) = 145 - a(120): j = 42: GoSub 3000: If fl1 = 1 Then GoTo 960
a(41) = 145 - a(119): j = 41: GoSub 3000: If fl1 = 1 Then GoTo 960
a(40) = 145 - a(118): j = 40: GoSub 3000: If fl1 = 1 Then GoTo 960
a(39) = 145 - a(117): j = 39: GoSub 3000: If fl1 = 1 Then GoTo 960
a(38) = 145 - a(116): j = 38: GoSub 3000: If fl1 = 1 Then GoTo 960
a(37) = 145 - a(115): j = 37: GoSub 3000: If fl1 = 1 Then GoTo 960
a(36) = 145 - a(102): j = 36: GoSub 3000: If fl1 = 1 Then GoTo 960
a(35) = 145 - a(101): j = 35: GoSub 3000: If fl1 = 1 Then GoTo 960
a(34) = 145 - a(100): j = 34: GoSub 3000: If fl1 = 1 Then GoTo 960
a(33) = 145 - a(99): j = 33: GoSub 3000: If fl1 = 1 Then GoTo 960
a(32) = 145 - a(98): j = 32: GoSub 3000: If fl1 = 1 Then GoTo 960
a(31) = 145 - a(97): j = 31: GoSub 3000: If fl1 = 1 Then GoTo 960
a(30) = 145 - a(108): j = 30: GoSub 3000: If fl1 = 1 Then GoTo 960
a(29) = 145 - a(107): j = 29: GoSub 3000: If fl1 = 1 Then GoTo 960
a(28) = 145 - a(106): j = 28: GoSub 3000: If fl1 = 1 Then GoTo 960
a(27) = 145 - a(105): j = 27: GoSub 3000: If fl1 = 1 Then GoTo 960
a(26) = 145 - a(104): j = 26: GoSub 3000: If fl1 = 1 Then GoTo 960
a(25) = 145 - a(103): j = 25: GoSub 3000: If fl1 = 1 Then GoTo 960
a(24) = 145 - a(90): j = 24: GoSub 3000: If fl1 = 1 Then GoTo 960
a(23) = 145 - a(89): j = 23: GoSub 3000: If fl1 = 1 Then GoTo 960
a(22) = 145 - a(88): j = 22: GoSub 3000: If fl1 = 1 Then GoTo 960
a(21) = 145 - a(87): j = 21: GoSub 3000: If fl1 = 1 Then GoTo 960
a(20) = 145 - a(86): j = 20: GoSub 3000: If fl1 = 1 Then GoTo 960
a(19) = 145 - a(85): j = 19: GoSub 3000: If fl1 = 1 Then GoTo 960
a(18) = 145 - a(96): j = 18: GoSub 3000: If fl1 = 1 Then GoTo 960
a(17) = 145 - a(95): j = 17: GoSub 3000: If fl1 = 1 Then GoTo 960
a(16) = 145 - a(94): j = 16: GoSub 3000: If fl1 = 1 Then GoTo 960
a(15) = 145 - a(93): j = 15: GoSub 3000: If fl1 = 1 Then GoTo 960
a(14) = 145 - a(92): j = 14: GoSub 3000: If fl1 = 1 Then GoTo 960
a(13) = 145 - a(91): j = 13: GoSub 3000: If fl1 = 1 Then GoTo 960
a(12) = 145 - a(78): j = 12: GoSub 3000: If fl1 = 1 Then GoTo 960
a(11) = 145 - a(77): j = 11: GoSub 3000: If fl1 = 1 Then GoTo 960
a(10) = 145 - a(76): j = 10: GoSub 3000: If fl1 = 1 Then GoTo 960
a(9) = 145 - a(75): j = 9: GoSub 3000: If fl1 = 1 Then GoTo 960
a(8) = 145 - a(74): j = 8: GoSub 3000: If fl1 = 1 Then GoTo 960
a(7) = 145 - a(73): j = 7: GoSub 3000: If fl1 = 1 Then GoTo 960
a(6) = 145 - a(84): j = 6: GoSub 3000: If fl1 = 1 Then GoTo 960
a(5) = 145 - a(83): j = 5: GoSub 3000: If fl1 = 1 Then GoTo 960
a(4) = 145 - a(82): j = 4: GoSub 3000: If fl1 = 1 Then GoTo 960
a(3) = 145 - a(81): j = 3: GoSub 3000: If fl1 = 1 Then GoTo 960
a(2) = 145 - a(80): j = 2: GoSub 3000: If fl1 = 1 Then GoTo 960
a(1) = 145 - a(79): j = 1: GoSub 3000: If fl1 = 1 Then GoTo 960

For i10 = 1 To 12
    GoSub 1500: If Res12(i10) <> r12 Then GoTo 955
Next i10

                           n9 = n9 + 1
''                         GoSub 2650 'Print results (squares)
                           GoSub 2645 'Print results (selected numbers)

If n9 = 196 Then End

955 jj = 96:  GoSub 3050           'Reset b() and c()
960 Next j96

1075 jj = 108: GoSub 3050          'Reset b() and c()
1080 Next j108

1195 jj = 120: GoSub 3050          'Reset b() and c()
1200 Next j120

1315 jj = 132: GoSub 3050          'Reset b() and c()
1320 Next j132

1385 jj = 139: GoSub 3050           'Reset b() and c()
1390 Next j139
     m16 = 1

1395 b(c(140)) = 0: c(140) = 0
1400 Next j140
     m15 = 1
     
1405 b(c(141)) = 0: c(141) = 0
1410 Next j141
     m14 = 1
    
1415 b(c(142)) = 0: c(142) = 0
1420 Next j142
     m13 = 1

     b(c(143)) = 0: c(143) = 0
1430 Next j143
     m12 = 2

     b(c(144)) = 0: c(144) = 0
1440 Next j144
     m11 = 1

    t2 = Timer
    
    t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
    y = MsgBox(t10, 0, "Routine MostPerf12")

End

'    Print results (selected numbers)

2645 ''Cells(n9, 138).Select
     For i1 = 1 To 144
         Cells(n9, i1).Value = a(i1)
     Next i1
     Cells(n9, 145).Value = n9
     Cells(1, 146).Value = n9
     Return

'    Print results (squares)

2650 n2 = n2 + 1
     If n2 = 3 Then
         n2 = 1: k1 = k1 + 13: k2 = 1
     Else
         If n9 > 1 Then k2 = k2 + 13
     End If
     Cells(k1, k2 + 1).Value = n9
    
     i3 = 0
     For i1 = 1 To 12
         For i2 = 1 To 12
             i3 = i3 + 1
             Cells(k1 + i1, k2 + i2).Value = a(i3)
         Next i2
     Next i1
    
     Return
     
'    Exclude identical solutions and solutions out of range
     
3000 fl1 = 0
     If a(j) <= 0 Or a(j) > 144 Or CInt(a(j)) <> a(j) Then fl1 = 1: GoTo 3010
     If b(a(j)) = 0 Then b(a(j)) = a(j): c(j) = a(j) Else fl1 = 1
3010 If fl1 = 1 Then                                               'Reset b() and c()
        For i = j + 1 To jj
             b(c(i)) = 0: c(i) = 0
        Next i
     End If
     Return

'    Reset b() and c() after completion loop

3050 For i = j To jj
         b(c(i)) = 0: c(i) = 0
     Next i
     Return

'   determine Resudu lin i10

1500

    Select Case i10
    
'       Rows
    
        Case 1 To 12:
                For i1 = 1 To 12: b12(i1) = a((i10 - 1) * 12 + i1): Next i1
                GoSub 1550

'       Columns
        
        Case 13 To 24:
                For i1 = 1 To 12: b12(i1) = a((i10 - 12) + (i1 - 1) * 12): Next i1
                GoSub 1550

'       Diagonals
        
        Case 25:
                For i1 = 1 To 12: b12(i1) = a(i1 + (i1 - 1) * 12): Next i1
                GoSub 1550
        Case 26:
                For i1 = 1 To 12: b12(i1) = a(12 - i1 + 1 + (i1 - 1) * 12): Next i1
                GoSub 1550
                                                       
    End Select

    Return

1550

    For i2 = 1 To 11
    For i1 = i2 To 12
        If b12(i2) < b12(i1) Then
            x = b12(i1)
            b12(i1) = b12(i2)
            b12(i2) = x
        End If
    Next i1
    Next i2

    Res12(i10) = b12(1) - b12(2) + b12(3) - b12(4) + b12(5) - b12(6) + b12(7) - b12(8) + b12(9) - b12(10) + b12(11) - b12(12)

    Return

End Sub

Vorige Pagina About the Author