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

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

VBA

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