【VB】関数ポインタっぽいことをする【.Net】

cやc++の関数ポインタは、相手に処理を渡したいというときに非常に便利なので、別言語でもそれっぽいことがしたいです。
以前の記事ではJavaでFunctionを使ってこれを実現しました。
今回は.NetのFuncを使い、VBで同じようなことを実現します。

参考記事

@Ryota Murohoshi様による、より詳細な（Funcを含めた）Delegateに関する解説記事です。
qiita.com

やり方

受け取って使う

以下は簡単なクイックソートのコードです。Comp As Func(Of Tuple(Of T, T), Boolean)の部分が関数を受け取る部分です。
c++のsort関数では比較処理をラムダで渡したりしますが、あれと同じです。

Function QSort(Of T)(ByVal Array As T(), ByRef Comp As Func(Of Tuple(Of T, T), Boolean)) As T()
    If (Array.Length < 3) Then
        If (Array.Length = 2 AndAlso Not Comp(New Tuple(Of T, T)(Array(0), Array(1)))) Then SWAP(Array(0), Array(1))
        Return Array
    End If

    Dim big As New List(Of T)
    Dim small As New List(Of T)

    For i = 1 To Array.Length - 1
        If Comp(New Tuple(Of T, T)(Array(0), Array(i))) Then
            big.Add(Array(i))
        Else
            small.Add(Array(i))
        End If
    Next

    Dim result As New List(Of T)(QSort(small.ToArray, Comp)) From {
        Array(0)
    }
    result.AddRange(QSort(big.ToArray, Comp))
    Return result.ToArray
End Function

渡す

関数を渡す方法としては、ラムダを渡すか、関数を定義してAdressOfで渡すかの2通りあります。オマケとして、関数を用意しておけば反転はラムダで簡単に書けますね。

Sub Main()
    Dim array = {"dd", "aaa", "eee", "cccc", "b"}

    '長さソート
    Console.WriteLine("Length")
    For Each str As String In QSort(array,
                                    Function(ByVal t As Tuple(Of String, String)) As Boolean
                                        Return (t.Item1.Length < t.Item2.Length)
                                    End Function)
        Console.WriteLine(str)
    Next

    '1文字目ソート
    Console.WriteLine("First Char")
    For Each str As String In QSort(array,
                                    AddressOf CompFirst_LT)
        Console.WriteLine(str)
    Next

    '1文字目逆順
    Console.WriteLine("First Char(reverse)")
    For Each str As String In QSort(array,
                                    Function(ByVal t As Tuple(Of String, String)) As Boolean
                                        Return Not CompFirst_LT(t)
                                    End Function)
        Console.WriteLine(str)
    Next

    Console.ReadKey()
End Sub

雑感

それでも関数ポインタのが便利だと思います……。

オマケ

コード全文

Module Module1
    Sub SWAP(Of T)(ByRef p1 As T, ByRef p2 As T)
        Dim temp = p1
        p1 = p2
        p2 = temp
    End Sub

    Function QSort(Of T)(ByVal Array As T(), ByRef Comp As Func(Of Tuple(Of T, T), Boolean)) As T()
        If (Array.Length < 3) Then
            If (Array.Length = 2 AndAlso Not Comp(New Tuple(Of T, T)(Array(0), Array(1)))) Then SWAP(Array(0), Array(1))
            Return Array
        End If

        Dim big As New List(Of T)
        Dim small As New List(Of T)

        For i = 1 To Array.Length - 1
            If Comp(New Tuple(Of T, T)(Array(0), Array(i))) Then
                big.Add(Array(i))
            Else
                small.Add(Array(i))
            End If
        Next

        Dim result As New List(Of T)(QSort(small.ToArray, Comp)) From {
            Array(0)
        }
        result.AddRange(QSort(big.ToArray, Comp))
        Return result.ToArray
    End Function

    Function CompFirst_LT(ByVal t As Tuple(Of String, String)) As Boolean
        Return t.Item1(0) < t.Item2(0)
    End Function

    Sub Main()
        Dim array = {"dd", "aaa", "eee", "cccc", "b"}

        '長さソート
        Console.WriteLine("Length")
        For Each str As String In QSort(array,
                                        Function(ByVal t As Tuple(Of String, String)) As Boolean
                                            Return (t.Item1.Length < t.Item2.Length)
                                        End Function)
            Console.WriteLine(str)
        Next

        '1文字目ソート
        Console.WriteLine("First Char")
        For Each str As String In QSort(array,
                                        AddressOf CompFirst_LT)
            Console.WriteLine(str)
        Next

        '1文字目逆順
        Console.WriteLine("First Char(reverse)")
        For Each str As String In QSort(array,
                                        Function(ByVal t As Tuple(Of String, String)) As Boolean
                                            Return Not CompFirst_LT(t)
                                        End Function)
            Console.WriteLine(str)
        Next

        Console.ReadKey()
    End Sub
End Module

実行結果

Length
b
dd
eee
aaa
cccc
First Char
aaa
b
cccc
dd
eee
First Char(reverse)
eee
dd
cccc
b
aaa