Här kommer kod i VB (Ni vet den där utdaterade fossilen)...
Klarar av 4x4 på ~5 sekunder (AMD X2 3800+, enkeltrådat, tid uppmätt med Process Explorer)...
Kernel: 0.046
User Time: 04.937
Total Time: 04.984
Option Explicit
Private Const MAGIC_SIZE = 4
Private Const MAGIC_NUMBERS = MAGIC_SIZE * MAGIC_SIZE
Private Const MAGIC_SUM = (MAGIC_SIZE * (MAGIC_SIZE * MAGIC_SIZE + 1)) \ 2
Private Type GROUPITEM
Count As Long
Sum As Long
End Type
Private m_BitValue(1 To 30) As Long
Private m_Pos(1 To MAGIC_NUMBERS) As POINTL
Private m_Data(1 To MAGIC_SIZE, 1 To MAGIC_SIZE) As Long
Private m_Perms(1 To MAGIC_SIZE, 1 To MAGIC_SUM) As Long
Private m_Group(1 To 2, 1 To MAGIC_SIZE + 1) As GROUPITEM
Private Sub Command1_Click()
Dim a As Long
Dim x As Long
Dim y As Long
Dim CurrPosAdd As Boolean
Dim CurrDirection As Long
Command1.Enabled = False
Call GetPerms(0, 0)
For x = 1 To MAGIC_SIZE
For y = 1 To MAGIC_SIZE
m_Data(x, y) = 0
Next
Next
x = 0
y = 1
CurrDirection = 0
For a = 1 To MAGIC_NUMBERS
CurrPosAdd = False
Do
Select Case CurrDirection
Case 0
x = x + 1
If (x > MAGIC_SIZE) Then
x = x - 1
CurrDirection = CurrDirection + 1
ElseIf (m_Data(x, y) = 1) Then
x = x - 1
CurrDirection = CurrDirection + 1
Else
CurrPosAdd = True
End If
Case 1
y = y + 1
If (y > MAGIC_SIZE) Then
y = y - 1
CurrDirection = CurrDirection + 1
ElseIf (m_Data(x, y) = 1) Then
y = y - 1
CurrDirection = CurrDirection + 1
Else
CurrPosAdd = True
End If
Case 2
x = x - 1
If (x < 1) Then
x = x + 1
CurrDirection = CurrDirection + 1
ElseIf (m_Data(x, y) = 1) Then
x = x + 1
CurrDirection = CurrDirection + 1
Else
CurrPosAdd = True
End If
Case 3
y = y - 1
If (y < 1) Then
y = y + 1
CurrDirection = 0
ElseIf (m_Data(x, y) = 1) Then
y = y + 1
CurrDirection = 0
Else
CurrPosAdd = True
End If
End Select
Loop Until (CurrPosAdd)
m_Pos(a).x = x
m_Pos(a).y = y
m_Data(x, y) = 1
Next
For x = 1 To MAGIC_SIZE
For y = 1 To MAGIC_SIZE
m_Data(x, y) = 0
Next
Next
Call Test
Command1.Enabled = True
End Sub
Private Sub Test()
Dim oo As Long
Open "R:\Data.txt" For Output As #1
oo = GetTickCount()
Print #1, "Found: " & GoNext() & " magic numbers of size 4"
Print #1, "Time: " & GetTickCount() - oo & "ms"
Close #1
End Sub
Private Sub GoMatch()
Print #1, MatrixToString()
End Sub
Private Function GoNext(Optional ByVal Pos As Long = 1, Optional ByVal GlobalPerms As Long = 0, Optional ByRef Counter As Long) As Long
Dim a As Long
Dim x As Long
Dim y As Long
Dim CurrPerms As Long
'Print out matching matrixes
If (Pos > MAGIC_NUMBERS) Then
Counter = Counter + 1
If (Counter Mod 100 = 0) Then
Me.Caption = Counter
DoEvents
End If
Call GoMatch
Exit Function
End If
'Resolve pos coordinates
x = m_Pos(Pos).x
y = m_Pos(Pos).y
'Start with global permuations (values used
'by the current stack call is removed)
If (GlobalPerms = 0) Then GlobalPerms = 2 ^ (MAGIC_NUMBERS + 1) - 1
CurrPerms = GlobalPerms
'Restrict to permutatons only allowed
'by the same horizontal/vertical/diagonal line
With m_Group(1, x)
CurrPerms = CurrPerms And m_Perms(MAGIC_SIZE - .Count, MAGIC_SUM - .Sum)
End With
With m_Group(2, y)
CurrPerms = CurrPerms And m_Perms(MAGIC_SIZE - .Count, MAGIC_SUM - .Sum)
End With
If (x = y) Then
With m_Group(1, MAGIC_SIZE + 1)
CurrPerms = CurrPerms And m_Perms(MAGIC_SIZE - .Count, MAGIC_SUM - .Sum)
End With
End If
If ((MAGIC_SIZE + 1 - x) = y) Then
With m_Group(2, MAGIC_SIZE + 1)
CurrPerms = CurrPerms And m_Perms(MAGIC_SIZE - .Count, MAGIC_SUM - .Sum)
End With
End If
'Update the value counter of the same
'horizontal/vertical/diagonal lines
With m_Group(1, x)
.Count = .Count + 1
End With
With m_Group(2, y)
.Count = .Count + 1
End With
If (x = y) Then
With m_Group(1, MAGIC_SIZE + 1)
.Count = .Count + 1
End With
End If
If ((MAGIC_SIZE + 1 - x) = y) Then
With m_Group(2, MAGIC_SIZE + 1)
.Count = .Count + 1
End With
End If
'Enumerate allowed permutations
For a = 1 To MAGIC_NUMBERS
If ((CurrPerms And m_BitValue(a)) = m_BitValue(a)) Then
m_Data(x, y) = a
With m_Group(1, x)
.Sum = .Sum + a
End With
With m_Group(2, y)
.Sum = .Sum + a
End With
If (x = y) Then
With m_Group(1, MAGIC_SIZE + 1)
.Sum = .Sum + a
End With
End If
If ((MAGIC_SIZE + 1 - x) = y) Then
With m_Group(2, MAGIC_SIZE + 1)
.Sum = .Sum + a
End With
End If
Call GoNext(Pos + 1, GlobalPerms And (Not (m_BitValue(a))), Counter)
With m_Group(1, x)
.Sum = .Sum - a
End With
With m_Group(2, y)
.Sum = .Sum - a
End With
If (x = y) Then
With m_Group(1, MAGIC_SIZE + 1)
.Sum = .Sum - a
End With
End If
If ((MAGIC_SIZE + 1 - x) = y) Then
With m_Group(2, MAGIC_SIZE + 1)
.Sum = .Sum - a
End With
End If
End If
Next
'Update the value counter of the same
'horizontal/vertical/diagonal lines
With m_Group(1, x)
.Count = .Count - 1
End With
With m_Group(2, y)
.Count = .Count - 1
End With
If (x = y) Then
With m_Group(1, MAGIC_SIZE + 1)
.Count = .Count - 1
End With
End If
If ((MAGIC_SIZE + 1 - x) = y) Then
With m_Group(2, MAGIC_SIZE + 1)
.Count = .Count - 1
End With
End If
'Reset the cell
m_Data(x, y) = 0
'Return the number of permutations
If (Pos = 1) Then
GoNext = Counter
End If
End Function
Function MatrixToString() As String
Dim a As Long
Dim x As Long
Dim y As Long
For y = 1 To MAGIC_SIZE
For x = 1 To MAGIC_SIZE
MatrixToString = MatrixToString & m_Data(x, y) & " "
Next
MatrixToString = MatrixToString & vbCrLf
Next
End Function
Private Function GetPerms(ByVal Value As Long, ByVal Count As Long) As Long
Dim a As Long
Dim CurrSum As Long
For a = 1 To MAGIC_NUMBERS
CurrSum = Value + a
If (CurrSum <= MAGIC_SUM) Then
m_Perms(Count + 1, CurrSum) = m_Perms(Count + 1, CurrSum) Or m_BitValue(a)
If ((Count + 1) < MAGIC_SIZE) Then Call GetPerms(CurrSum, Count + 1)
End If
Next
End Function
Private Sub Form_Load()
Dim a As Long
For a = LBound(m_BitValue) To UBound(m_BitValue)
m_BitValue(a) = 2 ^ a
Next
End Sub
