読者です 読者をやめる 読者になる 読者になる

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を使ってファンクタ化されたもの

ジャグ配列をフラットな配列に展開

コーへーさんのブログからネタを拝借させていただく。

callmekohei.hatenablog.com

すでにthomさんもこのネタで記事を書いているので、VBAHaskellを使って少し違う方向性でやってみたい。

目標

ジャグ配列、たとえば Array(1, Array(2, Array(3, Array(4, Array(5), 6))), 7) をフラットな配列Array(1, 2, 3, 4, 5, 6, 7) に展開する。

方針

次のような関数curiouslyRecursive を作る。

  1. 出力用の配列を受け取り、その末尾に対象配列の各要素を順に追記していく。要素自身が配列である時は再帰的に処理する。
  2. 上記の繰り返し処理は畳み込み関数foldlで表現する。
  3. 配列の末尾に追記するときはサイズを拡張しなければならないので、処理効率が気になる。(配列結合関数catVを繰り返し呼び出すのは得策ではない。)この問題をなるべく汎用的に扱えるよう、イテレータ *1 にその機能を持たせることにし、そのための新しい関数iterator_push_exを追加する。
  4. この関数自体をfoldlの引数に渡す!

コード

' 少しだけ奇妙な再帰
Function curiouslyRecursive(ByRef it As Variant, ByRef x As Variant) As Variant
    If IsArray(x) Then  ' 配列の場合
        curiouslyRecursive = foldl(p_curiouslyRecursive, it, x)  ' ← ここ
    Else  ' 単一変数の場合
        curiouslyRecursive = iterator_push_ex(it, x)     ' 単純に末尾に追加
    End If
End Function
    ' この関数を関数ポインタ化したもの
    Function p_curiouslyRecursive(Optional ByRef firstParam As Variant, Optional ByRef secondParam As Variant) As Variant
        p_curiouslyRecursive = make_funPointer(AddressOf curiouslyRecursive, firstParam, secondParam)
    End Function

' テスト関数
Sub curiouslyRecursiveTest()
    Dim arr As Variant
    arr = Array(1, Array(2, Array(3, Array(4, Array(5), 6))), 7) ' ジャグ配列
    Dim ret As Variant: ret = Array()    ' 結果出力用配列
    Dim it As Variant:  it = make_iterator(ret)
    it = curiouslyRecursive(it, arr)
    ret = release_iterator(it)
    ReDim Preserve ret(0 To iterator_pos(it))
    printS ret  ' サイズ表示
    printM ret  ' 配列の内容表示
End Sub

「ここ」とコメントした箇所で、自分自身をfoldlの引数に渡している。配列ではない単一の変数に到達するまで再帰的に呼び出され、単一変数になったらそれを末尾に追加することになる。

イテレータに新規に導入した関数

イテレータが指し示す位置に要素を追加するが、位置が配列の UBound を超えていたらサイズを2倍にしてから追加する。

' 範囲拡張しながらiterator_push
Function iterator_push_ex(ByRef it As Variant, ByRef x As Variant) As Variant
    Dim m As Long: m = max_fun(it(1), 2 * UBound(it(0)) - LBound(it(0)) + 1)
    If UBound(it(0)) < it(1) Then
        Dim tmp As Variant
        swapVariant tmp, it(0)
        ReDim Preserve tmp(LBound(tmp) To m)
        swapVariant tmp, it(0)
    End If
    iterator_push_ex = iterator_push(it, x)
End Function

モジュール

イテレータ
https://github.com/mYmd/VBA/blob/master/Haskell_6_iterator.bas
テスト関数
VBA/test_module.bas at master · mYmd/VBA · GitHub