MM26 VB.NET Solution (optimal call check time)

Permute.vb

Option Explicit On
Option Strict   On
Option Compare  Binary
Option Infer    On

Imports System

Public Class Permute
    Property limit As Integer = 29800
    Public Function findOrder(w() As Double) As Integer()
        Dim time0 As Integer = Environment.TickCount + limit

        Dim n As Integer = CInt(Math.Sqrt(CDbl(w.Length)))

        Dim ret(n - 1) As Integer
        For i As Integer = 0 To n - 1
            ret(i) = i
        Next i

        Dim sc As Double = 0.0
        For i As Integer = 0 To n - 2
            Dim rn As Integer = ret(i) * n
            For j As Integer = i + 1 To n - 1
                sc += w(rn + ret(j))
            Next j
        Next i

        Dim lp As Long = 0
        Dim a As Integer = 0, b As Integer = 1

        Do
            If (lp And 8191) = 0 Then
                Dim time1 As Integer = Environment.TickCount
                If time1 > time0 Then Exit Do
            End If

            lp += 1

            Dim ra As Integer = ret(a)
            Dim rb As Integer = ret(b)
            Dim ran As Integer = ra * n
            Dim rbn As Integer = rb * n

            Dim dsc As Double = w(rbn + ra) - w(ran + rb)
            For i As Integer = a + 1 To b - 1
                Dim r As Integer = ret(i)
                Dim rn As Integer = r * n
                dsc += w(rbn + r) + w(rn + ra) - w(ran + r) - w(rn + rb)
            Next i

            If dsc > 0.0 Then
                ret(a) = rb
                ret(b) = ra
                sc += dsc
            End If

            b += 1
            If b >= n Then
                a += 1
                If a >= n - 1 Then a = 0
                b = a + 1
            End If

        Loop

        Dim dv As Double = CDbl(n) * Math.Sqrt(CDbl(n) * Math.Log(CDbl(n)) - CDbl(n)) / 100.0
        sc /= dv
        Console.Error.WriteLine("score={0}", sc)
        Console.Error.WriteLine("loop={0}", lp)

        findOrder = ret

    End Function

End Class