アッカーマン操作

今読んでいる本 『コンピュータは数学者になれるのか? 数学基礎論から証明とプログラムの理論へ (照井一成)』の155ページに アッカーマン操作 というものが登場した。Ackermann関数の数列版みたいなものである。
非負整数の有限列<...>に対して次のような変換のパターンが定義されていて、列の長さが1になったら終わるというものだ。

       {n, 0, ...}  ---->  {n + 1, ...}
    {0, m +1, ...}  ---->  {1, m, ...}
{n + 1, m +1, ...}  ---->  {n, m + 1, m, ...}
               {n}  ---->  end

この変換はVBAで簡単に定義できる。

Function Ackermann(ByRef a As Variant, ByRef dummy As Variant) As Variant
    Dim ret As Variant
    If sizeof(a) < 2 Then                ' sizeof は VBAHaskell の関数
        Ackermann = Empty
    ElseIf a(1) = 0 Then
        ret = tailN(a, sizeof(a) - 1)    ' tailN は VBAHaskell の関数
        ret(0) = a(0) + 1
        swapVariant Ackermann, ret       ' swapVariant は VBAHaskell の関数
    ElseIf a(0) = 0 Then
        ret = a
        ret(0) = 1
        ret(1) = a(1) - 1
        swapVariant Ackermann, ret
    Else
        ret = cons(a(0) - 1, a)          ' cons は VBAHaskell の関数
        ret(1) = a(1)
        ret(2) = a(1) - 1
        swapVariant Ackermann, ret
    End If
End Function

    Function p_Ackermann(Optional ByRef firstParam As Variant, Optional ByRef secondParam As Variant) As Variant
        p_Ackermann = make_funPointer(AddressOf Ackermann, firstParam, secondParam)
    End Function

VBAHaskell の generate_while_not 関数は、初期値からスタートして条件が成り立つまでのあいだ、操作を繰り返して履歴を出力する。
<1, 3> からスタートしてみると、108 のステップで終了した。

' //                  <1, 3> から   Empty になるまで Achermann 操作   (上限1000回)
m = generate_while_not(VBA.Array(1,3), p_is_empty, p_Ackermann, 1000)
?sizeof(m)
 108 
for each z in m : printM z : next z
  1  3
  0  3  2
  1  2  2
  0  2  1  2
  1  1  1  2
  0  1  0  1  2
  1  0  0  1  2
  2  0  1  2
  3  1  2
  2  1  0  2
  1  1  0  0  2
  0  1  0  0  0  2
  1  0  0  0  0  2
  2  0  0  0  2
  3  0  0  2
  4  0  2
  5  2
  4  2  1
  3  2  1  1
  2  2  1  1  1
  1  2  1  1  1  1
  0  2  1  1  1  1  1
  1  1  1  1  1  1  1
  0  1  0  1  1  1  1  1
  1  0  0  1  1  1  1  1
  2  0  1  1  1  1  1
  3  1  1  1  1  1
  2  1  0  1  1  1  1
  1  1  0  0  1  1  1  1
  0  1  0  0  0  1  1  1  1
  1  0  0  0  0  1  1  1  1
  2  0  0  0  1  1  1  1
  3  0  0  1  1  1  1
  4  0  1  1  1  1
  5  1  1  1  1
  4  1  0  1  1  1
  3  1  0  0  1  1  1
  2  1  0  0  0  1  1  1
  1  1  0  0  0  0  1  1  1
  0  1  0  0  0  0  0  1  1  1
  1  0  0  0  0  0  0  1  1  1
  2  0  0  0  0  0  1  1  1
  3  0  0  0  0  1  1  1
  4  0  0  0  1  1  1
  5  0  0  1  1  1
  6  0  1  1  1
  7  1  1  1
  6  1  0  1  1
  5  1  0  0  1  1
  4  1  0  0  0  1  1
  3  1  0  0  0  0  1  1
  2  1  0  0  0  0  0  1  1
  1  1  0  0  0  0  0  0  1  1
  0  1  0  0  0  0  0  0  0  1  1
  1  0  0  0  0  0  0  0  0  1  1
  2  0  0  0  0  0  0  0  1  1
  3  0  0  0  0  0  0  1  1
  4  0  0  0  0  0  1  1
  5  0  0  0  0  1  1
  6  0  0  0  1  1
  7  0  0  1  1
  8  0  1  1
  9  1  1
  8  1  0  1
  7  1  0  0  1
  6  1  0  0  0  1
  5  1  0  0  0  0  1
  4  1  0  0  0  0  0  1
  3  1  0  0  0  0  0  0  1
  2  1  0  0  0  0  0  0  0  1
  1  1  0  0  0  0  0  0  0  0  1
  0  1  0  0  0  0  0  0  0  0  0  1
  1  0  0  0  0  0  0  0  0  0  0  1
  2  0  0  0  0  0  0  0  0  0  1
  3  0  0  0  0  0  0  0  0  1
  4  0  0  0  0  0  0  0  1
  5  0  0  0  0  0  0  1
  6  0  0  0  0  0  1
  7  0  0  0  0  1
  8  0  0  0  1
  9  0  0  1
  10  0  1
  11  1
  10  1  0
  9  1  0  0
  8  1  0  0  0
  7  1  0  0  0  0
  6  1  0  0  0  0  0
  5  1  0  0  0  0  0  0
  4  1  0  0  0  0  0  0  0
  3  1  0  0  0  0  0  0  0  0
  2  1  0  0  0  0  0  0  0  0  0
  1  1  0  0  0  0  0  0  0  0  0  0
  0  1  0  0  0  0  0  0  0  0  0  0  0
  1  0  0  0  0  0  0  0  0  0  0  0  0
  2  0  0  0  0  0  0  0  0  0  0  0
  3  0  0  0  0  0  0  0  0  0  0
  4  0  0  0  0  0  0  0  0  0
  5  0  0  0  0  0  0  0  0
  6  0  0  0  0  0  0  0
  7  0  0  0  0  0  0
  8  0  0  0  0  0
  9  0  0  0  0
  10  0  0  0
  11  0  0
  12  0
  13

qiita.com

2つの表を比較する

また人様のネタを頂戴する。

整数からなる列がふたつあり、それぞれ 表A、表B とする。それぞれ片側にしかない数字を抽出しようというものだ。

vbaHaskellで短く書くとこうなる。ただし値ではなく、ある/ないの結果を 1 / 0 で表示した。

ab = unZip(mapF(p_equal_range(表B), 表A))
ba = unZip(mapF(p_equal_range(表A), 表B))
printM zipWith(p_less, ab(0), ab(1))
printM zipWith(p_less, ba(0), ba(1))

equal_rangelower_boundupper_bound の結果を同時に出力する関数で、それぞれソート済み配列の中から検索対象の値が存在する「先頭」および「最後の次」の場所を求めるものだ。
(モジュールはここ → https://github.com/mYmd/VBA/blob/master/Haskell_5_sort.bas
言い換えると目的とする値は [ lower_bound, upper_bound ) の中にあり、その個数は upper_bound - lower_bound で求められる。存在するかどうかだけなら、lower_bound < lower_bound が成り立つかどうかで判定できるので less 関数を使って計算している。

上のコードを少し冗長に書いてみる。

' //ふたつの表を表示してみる
printM 表A
  1  2  3  5  6  6  6  7  13  14  15  19  26  30  30
printM 表B
  1  4  5  7  7  8  9  10  10  11  12  13  17  17  20  20  20  24  27  30
' //AからBを見たときの equal_range
equal_range_from_A_to_B = mapF(p_equal_range(表B), 表A)
' //BからAを見たときの equal_range
equal_range_from_B_to_A = mapF(p_equal_range(表A), 表B)

' //equal_range_from_A_to_Bを表示してみる(説明は後からの手書き)
for each z in equal_range_from_A_to_B : printM z: next z
  0  1              <=  1は表B(0)にある   (0 < 1だから)
  1  1              <=  2は表Bにない      (1 = 1だから)
  1  1              <=  3は表Bにない
  2  3              <=  5は表B(2)にある
  3  3              <=  6は表Bにない
  3  3              <=  6は表Bにない
  3  3              <=  6は表Bにない
  3  5              <=  7は表B(3), B(4)にある
  11  12            <= 13は表B(11)にある
  12  12            <= 14は表Bにない
  12  12            <= 15は表Bにない
  14  14            <= 19は表Bにない
  18  18            <= 26は表Bにない
  19  20            <= 30は表B(19)にある
  19  20            <= 30は表B(19)にある
' //equal_range_from_B_to_Aを表示してみる(説明は後からの手書き)
for each z in equal_range_from_B_to_A : printM z: next z
  0  1              <=  1は表A(0)にある
  3  3              <=  4は表Aにない
  3  4              <=  5は表A(3)にある
  7  8              <=  7は表A(7)にある
  7  8              <=  7は表A(7)にある
  8  8              <=  8は表Aにない
  8  8              <=  9は表Aにない
  8  8              <= 10は表Aにない
  8  8              <= 10は表Aにない
  8  8              <= 11は表Aにない
  8  8              <= 12は表Aにない
  8  9              <= 13は表A(8)にある
  11  11            <= 17は表Aにない
  11  11            <= 17は表Aにない
  12  12            <= 20は表Aにない
  12  12            <= 20は表Aにない
  12  12            <= 20は表Aにない
  12  12            <= 24は表Aにない
  13  13            <= 27は表Aにない
  13  15            <= 30は表A(13), A(14)にある

' //結果を表示してみる
ab = unzip(equal_range_from_A_to_B)
printM zipWith(p_less, ab(0), ab(1))
  1  0  0  1  0  0  0  1  1  0  0  0  0  1  1
ba = unzip(equal_range_from_B_to_A)
printM zipWith(p_less, ba(0), ba(1))
  1  0  1  1  1  0  0  0  0  0  0  1  0  0  0  0  0  0  0  1

なお、unZip 関数はジャグ配列をほどいて以下のように再構成する関数である。

(
 (0, 1),
 (1, 1),
 (1, 1),
 (2, 3),
 (3, 3),
 (3, 3),
 (3, 3),
 (3, 5),
 (11, 12),
 (12, 12),
 (12, 12),
 (14, 14),
 (18, 18),
 (19, 20),
 (19, 20),
)

unZip ↓

(
 (0, 1, 1, 2, 3, 3, 3, 3, 11, 12, 12, 14, 18, 19, 19),
 (0, 1, 1, 3, 3, 3, 3, 5, 12, 12, 12, 14, 18, 20 ,20)
)

上の表Aと表Bはランダム数値を生成するモジュールで作った。
VBAHaskellの紹介 その25(乱数生成:メルセンヌ・ツイスタ mt19937) - Qiita

' //ランダムな整数を作ってソートしておく
表A = uniform_int_dist(15, 1, 30) : permutate 表A, sortIndex(表A)   ' //[1~30]から15個
表B = uniform_int_dist(20, 1, 30) : permutate 表B, sortIndex(表B)   ' //[1~30]から20個

3つの引数を持つ関数

VBAHaskellで3つ以上の引数を持つ関数をファンクタ化したい。 APIのレベルでそれをサポートする気は今のところないので、VBA側で簡易的な対応をした。

Haskell_1_Core.bas にそれをサポートする関数 make_funPointer_with_3_parameters を追加した。

'ユーザ関数をbindファンクタ化する(3つのパラメータを持つ関数)
Function make_funPointer_with_3_parameters(ByVal func1 As LongPtr, _
                                        ByVal func2 As LongPtr, _
                                    ByVal func3 As LongPtr, _
                            ByRef firstParam As Variant, _
                            ByRef secondParam As Variant, _
                            ByRef thirdParam As Variant) As Variant
    If Is_Missing_(firstParam) Or is_placeholder(firstParam) Then
        make_funPointer_with_3_parameters = _
            VBA.Array(func1, _
                      IIf(Is_Missing_(firstParam), placeholder, firstParam), _
                      VBA.Array(secondParam, thirdParam), _
                      placeholder _
                     )
    ElseIf Is_Missing_(secondParam) Or is_placeholder(secondParam) Then
        make_funPointer_with_3_parameters = _
            VBA.Array(func2, VBA.Array(firstParam, thirdParam), _
                      IIf(Is_Missing_(secondParam), placeholder, secondParam), _
                      placeholder _
                     )
    ElseIf Is_Missing_(thirdParam) Or is_placeholder(thirdParam) Then
        make_funPointer_with_3_parameters = _
            VBA.Array(func3, _
                      VBA.Array(firstParam, secondParam), _
                      IIf(Is_Missing_(thirdParam), placeholder, thirdParam), _
                      placeholder _
                     )
    Else
        make_funPointer_with_3_parameters = Empty
    End If
End Function

少しややこしいので、ファイルをコピーする簡単な関数 copyFile で説明する。
copyFile はコピー先フォルダ、コピー元フォルダ、ファイル名を指定してファイルをコピーするだけだが、これまで vbaHaskell では扱っていなかった3パラメータ関数だ。

これを vbaHaskell の mapF に渡すと次のようなことができる。

  • 複数のコピー先フォルダを指定する(バックアップ等で複数の場所にコピーする時など)
    • mapF(p_copyFile( , コピー元フォルダ, ファイル名 ), コピー先フォルダ配列)
  • 複数のファイルを指定する(全ファイルをコピーするなど)
    • mapF(p_copyFile( コピー先フォルダ, コピー元フォルダ ), ファイル名配列)

(コピー元フォルダを複数指定するのはこの場合意味がない)

mapF で実際に呼ばれているのは3通りの補助関数のどれかで、それらは従来通りの2変数関数である。つまり3変数関数と言ってもそのうち2つを配列にパックしているだけのことだ。

' //ファイルのコピー
Function copyFile(ByVal targetDirectory As String, _    ' //コピー先フォルダ
                 ByVal sourceDirectory As String, _    ' //コピー元フォルダ
                  ByVal fileName As String) As Long     ' //ファイル名
    copyFile = 0
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error GoTo myError
    fso.copyFile sourceDirectory & "\" & fileName, targetDirectory & "\" & fileName, True
    copyFile = 1
myError:
    Set fso = Nothing
End Function

    ' //ファンクタ化する
    Function p_copyFile(Optional ByRef firstParam As Variant, _
                        Optional ByRef secondParam As Variant, _
                        Optional ByRef thirdParam As Variant) As Variant
        p_copyFile = make_funPointer_with_3_parameters( _
                                    AddressOf copyFile_partial1, _
                                    AddressOf copyFile_partial2, _
                                    AddressOf copyFile_partial3, _
                                    firstParam, _
                                    secondParam, _
                                    thirdParam)
    End Function

    ' //どの引数をプレースホルダにするかによって3通りの補助関数を作る

    ' //第1引数(コピー先フォルダ)をプレースホルダにする
    Private Function copyFile_partial1(ByRef target As Variant, ByRef source_fname As Variant) As Variant
        copyFile_partial1 = copyFile(target, source_fname(0), source_fname(1))
    End Function

    ' //第2引数(コピー元フォルダ)をプレースホルダにする
    Private Function copyFile_partial2(ByRef target As Variant, ByRef source_fname As Variant) As Variant
        copyFile_partial2 = 0   ' こんなコピーは無理
    End Function

    ' //第3引数(ファイル名)をプレースホルダにする
    Private Function copyFile_partial3(ByRef target_source As Variant, ByRef fname As Variant) As Variant
        copyFile_partial3 = copyFile(target_source(0), target_source(1), fname)
    End Function

変数への代入

VBAで、変数に値を代入してそれを直接別の関数に渡したい。
しかし通常の = による代入を使おうとしたら下記の「方法1」ではダメで、「方法2」のように2行に分ける必要がある。

' 「方法1」
? UBound(x = Array(1,2,3))    ' NG、xへの代入ではなく等値比較になる(エラー)
' 「方法2」
x = Array(1,2,3)              ' OK、xへの代入
? UBound(x)                   ' OK
 2

VBAでは式中に出てくる = は代入構文ではなく等値比較(==)とみなされる。代入の意味で = を使おうとしたら単独の代入文にしなければならない。言語の仕様なので、これはどうしようもない。

そこで代入関数 assign を作ってみる。

' ターゲットにソースの値を代入してターゲットを返す
Function assign(ByRef target As Variant, ByRef source As Variant) As Variant
    target = source
    assign = target
End Function

? UBound(assign(x, Array(1,2,3))     ' OK、だがこれでいいのか・・・?
 2
? UBound(x)                          ' xにもちゃんと代入されているようだ・・・
 2

この方法がダメなところは、assign 関数が返す値がターゲットとなる変数のコピーにすぎないことだ。このことは以下のコードでわかる。

' assign を2度繰り返してみる
? UBound(assign(assign(x, Array(1,2,3)), Array(1,2,3,4)))
 3                 ' 最終的に Array(1,2,3,4) が評価されている
? UBound(x)
 2                 ' しかし x は Array(1,2,3) で止まってる

これではコードゴルフが捗らないし、対象が大きな配列の場合コピーを返すコストは無視できない。
VT_BYREF を使ってなんとかならないか試しているが今のところうまくいっていない。たとえば、

//VARIANT変数をmove代入し、Target自身を返す
VARIANT __stdcall
moveAssign(VARIANT* target, VARIANT* source)
{
    VARIANT ret;
    ::VariantInit(&ret);
    if ( target != source )
    {
        std::swap(*target, *source);
        ::VariantClear(source);
    }
    ret.vt = VT_BYREF | VT_VARIANT;
    ret.pvarVal = target;
    return ret;
}

これではうまくいかなかった。

x = 0
? UBound(moveAssign(moveAssign(x, Array(1,2,3)),Array(1,2,3,4)))   ' 実行時エラー'13': 型が一致しません。

? UBound(x)
 2                 ' 最初の moveAssign 呼び出しは実行されているようだ

C++14ラムダでの< > テンプレート?

さきほどqiitaに書いた記事、

qiita.com

C++ラムダ式に言及したのだが、よくわからなくなった。

まず、

[]<typename T>(T const& a, std::vector<std::vector<T>> const& b){
    auto tmp = b;
    for ( auto& i : tmp )    i.insert(i.begin(), a);
    tmp.insert(tmp.begin(), std::vector<T>{1, a});
    return tmp;
};

というラムダ式gccコンパイルできた。(C++14指定) http://melpon.org/wandbox/permlink/04WzozqwuAerr0Ps

しかしコンパイラの指定をclangにするとこのようにエラーになる。

f:id:mmYYmmdd:20151003095522j:plain

まずこの理由がわからない。< と > で囲んだテンプレート表現自体が使えないかのようなメッセージだ。

次に、コンテナを抽象化できないかと思って template template パラメータを試してみた。

   auto lm = []<typename T, template <typename> class V>(T&& a, V<V<std::decay_t<T>>> const& b) {
        auto tmp = b;
        for ( auto& i : tmp )    i.insert(i.begin(), a);
        tmp.insert(tmp.begin(), V<std::decay_t<T>>{1, a});
        return tmp;
    };

これはgccでもclangでも長いエラーメッセージが出てダメだった。 もしや、と思って次のようにしてみたがやっぱりダメだった。

   auto lm = []<typename T, template <typename> class V1, template <typename> class V2>(T&& a, V1<V2<std::decay_t<T>>> const& b) {
        auto tmp = b;
        for ( auto& i : tmp )    i.insert(i.begin(), a);
        tmp.insert(tmp.begin(), V2<std::decay_t<T>>{1, a});
        return tmp;
    };

次のように auto だけ使っていればどちらでもOK。

    auto lm = [](auto&& a, auto&& b) {
        auto tmp = b;
        for ( auto& i : tmp )    i.insert(i.begin(), a);
        using V = std::decay_t<decltype(*tmp.begin())>;
        tmp.insert(tmp.begin(), V{1, a});
        return tmp;
    };

気力がなくなってきた。

C - 友達の友達(AtCoder Beginner Contest 過去問)

AtCoder Beginner Contest の過去問題(016 2014/12/06 21:05:00 ~ 2014/12/06 23:05:00)をVBAHaskellでやってみた。

C: 友達の友達 - AtCoder Beginner Contest 016 | AtCoder

問題文
高橋くんはSNSの管理者をしています。このSNSではユーザ同士が友達という関係で繋がることができます。高橋くんはそれぞれのユーザの「友達の友達」が何人いるかを調べることにしました。友達関係が与えられるので、各ユーザの「友達の友達」の人数を求めてください。ただし、自分自身や友達は、「友達の友達」に含みません。
入力
入力は以下の形式で標準入力から与えられる。
N M
A1 B1
A2 B2
:
AM BM
1 行目には、ユーザ数 N(1≦N≦10) と友達の組の数 M(0≦M≦N×(N−1)⁄2) がスペース区切りで与えられる。 各ユーザには 1 から N までのユーザIDが割り当てられている。
2 行目からの M 行では、友達関係にあるユーザのID Ai,Bi(1≦Ai<Bi≦N) がスペース区切りで与えられる。ただし、 i≠j ならば (Ai,Bi)≠(Aj,Bj) を満たす。

N人のユーザに対して対称のものを重複せずに友達ペアを数えるとN×(N−1)⁄2となる、ということだろう。
問題文の入力例1は
3 3
1 2
1 3
2 3
となっているが、この場合はユーザが3人、友達が3組いて、対称分も含めると次の表のような友達関係になる。

1 2 3
1 0 1 1
2 1 0 1
3 1 1 0

以下のコードでは、このような友達マトリクスを作成してから各ユーザに対する友達の友達集合(直接の友達を含む)を計算し、そこから直接の友達と自分自身を取り除いている。友達関係であるか否かは1/0で表し、友達の行をフィルタリングしてから1のある場所をOR集計している。
mapFzipWithfoldl1といった関数に関数ポインタを渡して処理しているのがVBAHaskell的と言えるが、気に入らない点がある。やはりヘルパ関数のrowMaxsumOfLessの存在だ。こんなつまらない機能を外出しで定義しなければいけないのは面白くない。なんとかしたい。

'C - 友達の友達
'http://abc016.contest.atcoder.jp/tasks/abc016_3
'出力例
Sub test_friendsFriend()
    Dim inArr As Variant
    inArr = VBA.Array(VBA.Array(3, 2), _
                      VBA.Array(1, 2), _
                      VBA.Array(2, 3))
    printM friendsFriend(inArr)   '  1  0  1

    inArr = VBA.Array(VBA.Array(3, 3), _
                      VBA.Array(1, 2), _
                      VBA.Array(1, 3), _
                      VBA.Array(2, 3))
    printM friendsFriend(inArr)   '  0  0  0

    inArr = VBA.Array(VBA.Array(8, 12), _
                      VBA.Array(1, 6), _
                      VBA.Array(1, 7), _
                      VBA.Array(1, 8), _
                      VBA.Array(2, 5), _
                      VBA.Array(2, 6), _
                      VBA.Array(3, 5), _
                      VBA.Array(3, 6), _
                      VBA.Array(4, 5), _
                      VBA.Array(4, 8), _
                      VBA.Array(5, 6), _
                      VBA.Array(5, 7), _
                      VBA.Array(7, 8))
    printM friendsFriend(inArr)   '  4  4  4  5  2  3  4  2
End Sub

'友達の友達関数
Function friendsFriend(ByRef inArr As Variant)
    Dim fMatrix As Variant
    '友達マトリクス(IDは1始まりだが配列インデックスとして0始まりに変更)
    fMatrix = makeM(inArr(0)(0), inArr(0)(0), 0)
    Dim i As Long
    For i = LBound(inArr) + 1 To UBound(inArr) Step 1
        fMatrix(inArr(i)(0) - 1, inArr(i)(1) - 1) = 1
        fMatrix(inArr(i)(1) - 1, inArr(i)(0) - 1) = 1
    Next i
    '各ユーザの友達の友達集合
    Dim myFriends As Variant
    myFriends = mapF(p_rowMax, mapF(p_filterR(fMatrix), zipR(fMatrix)))
    '直接の友達を除外
    myFriends = zipWith(p_sumOfLess, zipR(fMatrix), myFriends)
    '自分自身を除外
    friendsFriend = mapF(p_minus(, 1), myFriends)
End Function

'2次元行列の行方向の最大値
Private Function rowMax(ByRef matrix As Variant, ByRef dummy As Variant) As Variant
    rowMax = foldl1(p_max, matrix, 1)
End Function
    Function p_rowMax(Optional ByRef firstParam As Variant, Optional ByRef secondParam As Variant) As Variant
        p_rowMax = make_funPointer(AddressOf rowMax, firstParam, secondParam)
    End Function

'ふたつの1次元行列a,bの各要素について(aの値 < bの値)の個数
Private Function sumOfLess(ByRef a As Variant, ByRef b As Variant) As Variant
    sumOfLess = foldl1(p_plus, zipWith(p_less, a, b))
End Function
    Function p_sumOfLess(Optional ByRef firstParam As Variant, Optional ByRef secondParam As Variant) As Variant
        p_sumOfLess = make_funPointer(AddressOf sumOfLess, firstParam, secondParam)
    End Function

qiita.com

if_else

以前qiitaに書いたVBAHaskellにおけるFizzBuzz実装の紹介記事で if_else 関数を使った。 qiita.com

ここで if_else 関数自体の説明を書く。
if_else およびこれを関数化した p_if_else Haskell_2_stdFunモジュールにある。

形式

Function if_else(ByRef val As Variant, ByRef trans As Variant) As Variant

  第1引数(val)は対象値
  第2引数(trans)は以下の要素からなる長さ3の1次元配列
   trans(0) : 判定の値/関数
   trans(1) : 真の時の変換値/関数
   trans(2) : 偽の時の変換値/関数

概要
trans(0)が関数 p_fn の場合*1、p_fn(val) の値、
trans(0)が関数でない場合、一致条件 val = trans(0) の判定結果、
のいずれかで真偽判定し、真の場合はtrans(1)、偽の場合はtrans(2)の処理にいく。
trans(1)やtrans(2)が関数の場合はそれにvalを適用したもの、そうでない場合はその値を戻り値とする。
ただしこの値がplaceholderだった場合は、val を戻り値とする。


与えられた整数が3の倍数の時は"Fizz"を、そうでないときはその整数を返す関数。
if_else(x, Array(p_mod(, 3), placeholder, "Fizz"))
x に整数を代入するとこうなる。
 x = 1 のとき ---> Mod(1, 3) = 1 ---> ---> placeholder ---> 1
 x = 2 のとき ---> Mod(2, 3) = 2 ---> ---> placeholder ---> 2
 x = 3 のとき ---> Mod(3, 3) = 0 ---> ---> "Fizz"
・・・
そこでMod 3,Mod 5,Mod 15に対してこれを関数化したものを作って組み合わせる。

fun3 = p_if_else(, Array(p_mod(, 3), placeholder, "Fizz"))
fun5 = p_if_else(, Array(p_mod(, 5), fun3, "Buzz"))
fun15 = p_if_else(, Array(p_mod(, 15), fun5, "FizzBuzz"))

このようにして構成した fun15 に対して、mapF(fun15, iota(1, 100)) とすれば1から100までのFizzBuzz列が作られる。

qiita.com

github.com

*1:make_funPointerを使ってファンクタ化されたもの