' Generates Moriyama Sudoku Comparable Cubes of order 5 for integers 0 thru 4 (Associated)
' Tested with Office 2007 under Windows 7
Sub SudCube5d2()
Dim a(125), b(5)
y = MsgBox("Locked", vbCritical, "Routine SudCube5d2")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 0: m2 = 4: s1 = 10: s2 = 2 * s1 / 5
Sheets("Klad1").Select
t1 = Timer
' Generate Cubes
a(63) = (m1 + m2) / 2
For j125 = m1 To m2
a(125) = j125
For j124 = m1 To m2
a(124) = j124
For j123 = m1 To m2
a(123) = j123
For j122 = m1 To m2
a(122) = j122
a(121) = s1 - a(122) - a(123) - a(124) - a(125)
If a(121) < m1 Or a(121) > m2 Then GoTo 1220
For j120 = m1 To m2
a(120) = j120
For j119 = m1 To m2
a(119) = j119
For j118 = m1 To m2
a(118) = j118
For j117 = m1 To m2
a(117) = j117
a(116) = s1 - a(117) - a(118) - a(119) - a(120): If a(116) < m1 Or a(116) > m2 Then GoTo 1170
a(115) = s1 - a(117) - a(118) - a(120) - a(125): If a(115) < m1 Or a(115) > m2 Then GoTo 1170
a(114) = a(118) + a(120) - a(124): If a(114) < m1 Or a(114) > m2 Then GoTo 1170
a(113) = a(117) + a(119) - a(123): If a(113) < m1 Or a(113) > m2 Then GoTo 1170
a(112) = s1 - a(117) - a(119) - a(120) - a(122): If a(112) < m1 Or a(112) > m2 Then GoTo 1170
a(111) = s1 - a(112) - a(113) - a(114) - a(115): If a(111) < m1 Or a(111) > m2 Then GoTo 1170
a(110) = a(111) + a(118) - a(124): If a(110) < m1 Or a(110) > m2 Then GoTo 1170
a(109) = s1 - a(118) - a(120) - a(123) - a(125): If a(109) < m1 Or a(109) > m2 Then GoTo 1170
a(108) = s1 - a(117) - a(119) - a(122) - a(124): If a(108) < m1 Or a(108) > m2 Then GoTo 1170
a(107) = s1 - a(116) - a(118) - a(121) - a(123): If a(107) < m1 Or a(107) > m2 Then GoTo 1170
a(106) = s1 - a(107) - a(108) - a(109) - a(110): If a(106) < m1 Or a(106) > m2 Then GoTo 1170
a(105) = s1 - a(110) - a(115) - a(120) - a(125): If a(105) < m1 Or a(105) > m2 Then GoTo 1170
a(104) = s1 - a(109) - a(114) - a(119) - a(124): If a(104) < m1 Or a(104) > m2 Then GoTo 1170
a(103) = s1 - a(108) - a(113) - a(118) - a(123): If a(103) < m1 Or a(103) > m2 Then GoTo 1170
a(102) = s1 - a(107) - a(112) - a(117) - a(122): If a(102) < m1 Or a(102) > m2 Then GoTo 1170
a(101) = s1 - a(106) - a(111) - a(116) - a(121): If a(101) < m1 Or a(101) > m2 Then GoTo 1170
a(100) = 3 * s1 / 5 - a(116) - a(123): If a(100) < m1 Or a(100) > m2 Then GoTo 1170
a(99) = 3 * s1 / 5 - a(117) - a(122) + a(123) - a(124): If a(99) < m1 Or a(99) > m2 Then GoTo 1170
a(98) = -s2 - a(118) + 2 * a(122) + 2 * a(124): If a(98) < m1 Or a(98) > m2 Then GoTo 1170
a(97) = 3 * s1 / 5 - a(119) - a(122) + a(123) - a(124): If a(97) < m1 Or a(97) > m2 Then GoTo 1170
a(96) = s1 - a(97) - a(98) - a(99) - a(100): If a(96) < m1 Or a(96) > m2 Then GoTo 1170
a(95) = 4 * s2 - 2 * a(117) - a(118) - 2 * a(120) - a(122) - a(125): If a(95) < m1 Or a(95) > m2 Then GoTo 1170
a(94) = 3 * s1 / 5 - a(116) + a(120) - a(121) - a(123): If a(94) < m1 Or a(94) > m2 Then GoTo 1170
a(93) = 3 * s1 / 5 - a(122) - a(124): If a(93) < m1 Or a(93) > m2 Then GoTo 1170
a(92) = 3 * s1 / 5 + a(116) - a(120) - a(123) - a(125): If a(92) < m1 Or a(92) > m2 Then GoTo 1170
a(91) = s1 - a(92) - a(93) - a(94) - a(95): If a(91) < m1 Or a(91) > m2 Then GoTo 1170
a(90) = -s2 + 2 * a(117) + a(118) + 3 * a(120) - 2 * a(121) - a(124): If a(90) < m1 Or a(90) > m2 Then GoTo 1170
a(89) = 3 * s1 / 5 - a(117) - a(118) - 2 * a(120) + a(121) + a(124): If a(89) < m1 Or a(89) > m2 Then GoTo 1170
a(88) = -s2 + a(118) + a(121) + a(125): If a(88) < m1 Or a(88) > m2 Then GoTo 1170
a(87) = s1 / 5 - a(95) + a(119): If a(87) < m1 Or a(87) > m2 Then GoTo 1170
a(86) = s1 - a(87) - a(88) - a(89) - a(90): If a(86) < m1 Or a(86) > m2 Then GoTo 1170
a(85) = 13 * s1 / 5 - 2 * a(117) - 2 * a(118) - a(119) - 3 * a(120) - a(122) - a(123) - 2 * a(125)
If a(85) < m1 Or a(85) > m2 Then GoTo 1170
a(84) = 3 * s1 / 5 - a(116) - 2 * a(119) + a(123) - a(124) + a(125): If a(84) < m1 Or a(84) > m2 Then GoTo 1170
a(83) = s1 / 5 - a(97) + a(117): If a(83) < m1 Or a(83) > m2 Then GoTo 1170
a(82) = 4 * s2 - 2 * a(117) - a(120) - 2 * a(122) - a(124) - a(125): If a(82) < m1 Or a(82) > m2 Then GoTo 1170
a(81) = s1 - a(82) - a(83) - a(84) - a(85): If a(81) < m1 Or a(81) > m2 Then GoTo 1170
a(80) = s1 - a(85) - a(90) - a(95) - a(100): If a(80) < m1 Or a(80) > m2 Then GoTo 1170
a(79) = s1 - a(84) - a(89) - a(94) - a(99): If a(79) < m1 Or a(79) > m2 Then GoTo 1170
a(78) = s1 - a(83) - a(88) - a(93) - a(98): If a(78) < m1 Or a(78) > m2 Then GoTo 1170
a(77) = s1 - a(82) - a(87) - a(92) - a(97): If a(77) < m1 Or a(77) > m2 Then GoTo 1170
a(76) = s1 - a(81) - a(86) - a(91) - a(96): If a(76) < m1 Or a(76) > m2 Then GoTo 1170
a(75) = 3 * s2 - a(117) - a(120) - a(122) - a(124) - a(125): If a(75) < m1 Or a(75) > m2 Then GoTo 1170
a(74) = -2 * s2 + a(117) + a(119) + a(120) + 2 * a(122) - a(123) + a(124): If a(74) < m1 Or a(74) > m2 Then GoTo 1170
a(73) = 3 * s2 - a(117) - a(119) - 2 * a(122) + a(123) - 2 * a(124): If a(73) < m1 Or a(73) > m2 Then GoTo 1170
a(72) = -s2 + a(79) + a(124) + a(125): If a(72) < m1 Or a(72) > m2 Then GoTo 1170
a(71) = s1 - a(72) - a(73) - a(74) - a(75): If a(71) < m1 Or a(71) > m2 Then GoTo 1170
a(70) = 2 * s2 - a(86) - a(121) - a(125): If a(70) < m1 Or a(70) > m2 Then GoTo 1170
a(69) = 2 * s2 - a(87) - a(122) - a(124): If a(69) < m1 Or a(69) > m2 Then GoTo 1170
a(68) = s1 / 5 - a(118) + a(122) - a(123) + a(124): If a(68) < m1 Or a(68) > m2 Then GoTo 1170
a(67) = 3 * s1 / 5 + a(91) - a(117) - a(122) - a(124): If a(67) < m1 Or a(67) > m2 Then GoTo 1170
a(66) = s1 - a(67) - a(68) - a(69) - a(70): If a(66) < m1 Or a(66) > m2 Then GoTo 1170
a(65) = 3 * s1 / 5 + a(86) - a(120) - a(122) - a(123): If a(65) < m1 Or a(65) > m2 Then GoTo 1170
a(64) = 3 * s1 / 5 + a(81) - a(119) - a(120) - a(122): If a(64) < m1 Or a(64) > m2 Then GoTo 1170
a(1) = s2 - a(125): a(2) = s2 - a(124): a(3) = s2 - a(123): a(4) = s2 - a(122):
a(5) = s2 - a(121): a(6) = s2 - a(120): a(7) = s2 - a(119): a(8) = s2 - a(118):
a(9) = s2 - a(117): a(10) = s2 - a(116): a(11) = s2 - a(115): a(12) = s2 - a(114):
a(13) = s2 - a(113): a(14) = s2 - a(112): a(15) = s2 - a(111): a(16) = s2 - a(110):
a(17) = s2 - a(109): a(18) = s2 - a(108): a(19) = s2 - a(107): a(20) = s2 - a(106):
a(21) = s2 - a(105): a(22) = s2 - a(104): a(23) = s2 - a(103): a(24) = s2 - a(102):
a(25) = s2 - a(101): a(26) = s2 - a(100): a(27) = s2 - a(99): a(28) = s2 - a(98):
a(29) = s2 - a(97): a(30) = s2 - a(96): a(31) = s2 - a(95): a(32) = s2 - a(94):
a(33) = s2 - a(93): a(34) = s2 - a(92): a(35) = s2 - a(91): a(36) = s2 - a(90):
a(37) = s2 - a(89): a(38) = s2 - a(88): a(39) = s2 - a(87): a(40) = s2 - a(86):
a(41) = s2 - a(85): a(42) = s2 - a(84): a(43) = s2 - a(83): a(44) = s2 - a(82):
a(45) = s2 - a(81): a(46) = s2 - a(80): a(47) = s2 - a(79): a(48) = s2 - a(78):
a(49) = s2 - a(77): a(50) = s2 - a(76): a(51) = s2 - a(75): a(52) = s2 - a(74):
a(53) = s2 - a(73): a(54) = s2 - a(72): a(55) = s2 - a(71): a(56) = s2 - a(70):
a(57) = s2 - a(69): a(58) = s2 - a(68): a(59) = s2 - a(67): a(60) = s2 - a(66):
a(61) = s2 - a(65): a(62) = s2 - a(64):
' Exclude solutions with identical numbers in rows, colums, pillars
GoSub 800: If fl1 = 0 Then GoTo 1170
n9 = n9 + 1
' GoSub 1740 'Print results (selected numbers)
GoSub 1750 'Print results (planes 11, 12, 13, 14 and 15)
' GoSub 1760 'Print results (3d)
1170 Next j117
1180 Next j118
1190 Next j119
1200 Next j120
1220 Next j122
1230 Next j123
1240 Next j124
1250 Next j125
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions"
y = MsgBox(t10, 0, "Routine SudCube5d")
End
' Exclude solutions with identical numbers in rows, colums and pillars
800 fl1 = 1
' Rows
i1 = -4
For i0 = 1 To 25
i1 = i1 + 5
b(1) = a(i1): b(2) = a(i1 + 1): b(3) = a(i1 + 2): b(4) = a(i1 + 3): b(5) = a(i1 + 4)
GoSub 860
If fl1 = 0 Then Return
Next i0
' Columns
i1 = 0: i2 = 0
For i0 = 1 To 25
i1 = i1 + 1
b(1) = a(i1): b(2) = a(i1 + 5): b(3) = a(i1 + 10): b(4) = a(i1 + 15): b(5) = a(i1 + 20)
i2 = i2 + 1: If i2 = 5 Then i2 = 0: i1 = i1 + 20
GoSub 860
If fl1 = 0 Then Return
Next i0
' Pillars
i1 = 0: i2 = 0
For i0 = 1 To 25
i1 = i0
b(1) = a(i1): b(2) = a(i1 + 25): b(3) = a(i1 + 50): b(4) = a(i1 + 75): b(5) = a(i1 + 100)
GoSub 860
If fl1 = 0 Then Return
Next i0
Return
860 fl1 = 1
For j1 = 1 To 5
b2 = b(j1)
For j2 = (1 + j1) To 5
If b2 = b(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
' Print results (selected numbers)
1740 For i1 = 1 To 125
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (planes 11, 12, 13, 14 and 15)
1750 n2 = n2 + 1
If n2 = 7 Then
n2 = 1: k1 = k1 + 30: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 6
End If
For i0 = 1 To 5
i3 = (5 - i0) * 25
For i1 = 1 To 5
For i2 = 1 To 5
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 6, k2 + i2).Value = a(i3)
Next i2
Next i1
If i0 = 1 Then
Cells(k1 + (i0 - 1) * 6, k2 + 1).Value = "Plane 1" + CStr(i0) + ", C" + CStr(n9)
Else
Cells(k1 + (i0 - 1) * 6, k2 + 1).Value = "Plane 1" + CStr(i0)
End If
Next i0
Return
' Print results (3d)
1760 n2 = n2 + 1
If n2 = 4 Then
n2 = 1: k1 = k1 + 46: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 22
End If
For i0 = 1 To 5
i3 = (5 - i0) * 25
For i1 = 1 To 5
For i2 = 1 To 5
i3 = i3 + 1
Cells(k1 + 1 + (i1 - 1) * 2 + (i0 - 1) * 9, k2 + 9 + (i2 - 1) * 3 - (i1 - 1) * 2).Value = a(i3)
Next i2
Next i1
Next i0
Return
End Sub
