雙向排序

'雙向排序
Public Class Form1
    Dim counter = 0
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '雙向排序 - 一次取得剩餘未處理部份的最大最小值
        Dim n() = {9, 8, 7, 6, 5, 4, 3, 2, 10, 1}
        Dim i1 = 0
        Dim i2 = n.Length - 1
        While i1 < i2
            Dim j1 = i1 + 1
            Dim j2 = i2 - 1
            While j1 <= n.Length - 1
                If n(i1) > n(j1) Then
                    change(n(i1), n(j1))
                End If
                If n(i2) < n(j2) Then
                    change(n(i2), n(j2))
                End If
                j1 = j1 + 1
                j2 = j2 - 1
            End While
            i1 = i1 + 1
            i2 = i2 - 1
        End While
        Dim str1 = ""
        For i = 0 To n.Length - 1
            str1 = str1 & n(i) & Space(3)
        Next
        str1 = str1 & vbNewLine & "交換:" & counter & "次 " & vbNewLine
        '單向排序
        counter = 0
        Dim n1() = {9, 8, 7, 6, 5, 4, 3, 2, 10, 1}
        Dim f1 = 0
        While f1 <= n.Length - 1 - 1
            Dim g1 = f1 + 1
            While g1 <= n.Length - 1
                If n1(f1) > n1(g1) Then
                    change(n1(f1), n1(g1))
                End If
                g1 = g1 + 1
            End While
            f1 = f1 + 1
        End While
        For i = 0 To n.Length - 1
            str1 = str1 & n1(i) & Space(3)
        Next
        str1 = str1 & vbNewLine & "交換:" & counter & "次 " & vbNewLine
        MsgBox(str1)
        End
    End Sub
    Sub change(ByRef x, ByRef y)
        Dim t = x
        x = y
        y = t
        counter = counter + 1
    End Sub
End Class

遞迴版插入排序

'遞迴版插入排序
Public Class Form1
    Dim a() = {9, 1, 8, 7, 6, 5, 4, 10, 3, 2}
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim str1 = ""
        Call rsort(1, a)
        For i = 0 To a.Length - 1
            str1 = str1 & a(i) & Space(3)
        Next
        MsgBox(str1)
        End
    End Sub
    Sub rsort(ByVal n, ByRef a)
        If n = a.length Then
            Return
        Else
            Dim p = a(n)
            Dim j = 0
            While a(j) < p
                j = j + 1
            End While
            For k = n To j + 1 Step -1
                a(k) = a(k - 1)
            Next
            a(j) = p
            rsort(n + 1, a)
        End If
    End Sub
End Class

插入排序

Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim a() = {9, 1, 8, 7, 6, 5, 4, 10, 3, 2}
        For i = 1 To a.Length - 1
            Dim p = a(i)
            Dim j = 0
            While a(j) < p
                j = j + 1
            End While
            For k = i To j + 1 Step -1
                a(k) = a(k - 1)
            Next
            a(j) = p
        Next
        End
    End Sub

窮舉例

'窮舉例
'以1,2,3三個數字, 可重覆方式組成7
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '最佳解
        Dim n = 7
        Dim a() = {3, 2, 1}
        Dim ansStr = ""
        Dim i = 0
        While n > 0
            While n >= a(i)
                n = n - a(i)
                ansStr = ansStr & a(i)
            End While
            i = i + 1
        End While
        MsgBox(ansStr)
        '所有解
        n = 7
        Dim k(a.Length - 1) As Integer
        For i = 0 To a.Length - 1
            k(i) = n \ a(i)
        Next
        Dim str1 = ""
        Dim str2 = ""
        Dim j1, j2, j3
        Dim z = 0
        For j3 = 0 To k(0)
            For j2 = 0 To k(1)
                For j1 = 0 To k(2)
                    If 3 * j3 + 2 * j2 + 1 * j1 = n Then
                        z = z + 1
                        str1 = "解" & z & " --> " & " 3:" & j3 & " 2:" & j2 & " 1:" & j1
                        str2 = str2 & str1 & vbTab
                        If z Mod 5 = 0 Then str2 = str2 & vbNewLine
                    End If
                Next
            Next
        Next
        MsgBox(str2)
        End
    End Sub
End Class

Joseph Problem

'Joseph Problem
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim aL As New ArrayList
        Dim aLB As New ArrayList
        Dim aStr = "123456789ABCDE"
        For i = 1 To aStr.Length
            aL.Add(Mid(aStr, i, 1))
        Next
        Dim k = 3
        Dim ic = 0 + k - 1
        While aL.Count > 1
            ic = ic Mod aL.Count
            aLB.Add(aL.Item(ic))
            aL.RemoveAt(ic)
            ic = ic + k - 1
        End While
        MsgBox(aL.Item(0))
    End Sub
End Class