バラバシ=アルバートモデルの次数分布計算コードをF# で作ってみる

講義のレポート的な何か(忘却用メモ書き)。


バラバシ=アルバートモデルでネットワークをNまで成長させたとき、次数の分布がベき則に従うことを示せ、とかそんな感じの課題である。


ところで、レポートにプログラミング言語の指定はなかった。
ならF#で作るしかないじゃない!

思い付きのままに実装

コードはこちら。

module Barabasi

open System
open System.IO

// m=1での初期グラフ
let m1Init = [|0;1;0;1|]

// m=2での初期グラフ
let m2Init = [|0;1;0;1;1;2;1;2;2;0;2;0|]

// シミュレーション回数
let max = 9998

let rand = new Random()

// 新たな頂点とつながる頂点を決める
let createEdge list node =
  let index = list |> Array.length |> rand.Next
  let node2 = index |> Array.get list
  [|node;node2|]
  
// データカウント型のリストを同じ頂点ごとに辞書型(ここではtupleのリスト)に集約する
let rec aggregate result =
  function
  | [] -> result
  | (data,count)::xs  -> 
    result
    |> List.tryFind (fst >> ((=) data)) // 一致する頂点をみつける
    |> Option.map (fun (i,l) -> (i,count::l))   // 頂点の要素リストに個数を追加
    |> function
    | None ->
      let result = (data,[count])::result
      aggregate result xs
    | Some (i,l) ->
      let result = (i,l) :: (result |> List.filter (fst >> ((<>) i)))
      aggregate result xs

// 集約したデータのカウント数を足し上げて、頂点カウント型として返す非同期ワークフロー
let reduceCount data =
  async { return (fst data,data |> snd |> List.sum) }

// 各頂点の出現回数を数える
let countNodes data =
  data
  |> Array.map (fun i -> (i,1))
  |> Array.sort
  |> Array.toList
  |> aggregate []   // 頂点ごとに集約
  |> List.map reduceCount // 非同期ワークフローでカウント数の足し上げ
  |> Async.Parallel // 非同期式を並列に評価するための配列に変換
  |> Async.RunSynchronously // 非同期式を実行し、返り値を待つ

// m=1のの時のグラフの成長をシミュレート
let execm1 () =
  List.init max (fun i -> i+2)
  |> List.fold (fun list i -> i |> createEdge list |> Array.append list) m1Init

// m=2の時のグラフの成長をシミュレート
let execm2 () =

  List.init max (fun i -> i+3)
  |> List.fold begin
    fun list i ->
      let set1 = i |> createEdge list
      let set2 = i |> createEdge list
      set1 |> Array.append set2 |> Array.append list
  end m2Init

// 次数が一致する頂点の数をカウント
let countDegree list =
  list
  |> Array.unzip    // 頂点番号と次数のペアを分割する
  |> snd    // 次数のみ取得する
  |> Array.map (fun i -> (i,1))
  |> Array.sort
  |> Array.toList
  |> aggregate []   // 次数ごとに集約
  |> List.map reduceCount // 非同期ワークフローでカウント数の足し上げ
  |> Async.Parallel // 非同期式を並列に評価するための配列に変換
  |> Async.RunSynchronously // 非同期式を実行し、返り値を待つ

// P(k)を計算してファイルに書き込む
let writeData (name:string) max (list:(int*int) array) =
  use stream = new IO.FileStream(name, FileMode.Create, FileAccess.Write)
  use writer = new StreamWriter(stream)
  list |> Array.iteri (fun (i) (node,count) ->
    let p = (decimal count) / decimal max   // P(k)の計算
    if p <> 0M then writer.WriteLine((string node) + " " + (string p))
  )

[<EntryPoint>]
let main _ =
  // m=1についてP(k)の計算
  async {
    execm1 () |> countNodes |> countDegree |> writeData @".\execm1.txt" (max+2)
    printfn "%s" "m=1 end."
  } |> Async.Start
  // m=1についてP(k)の計算
  execm2 () |> countNodes |> countDegree |> writeData @".\execm2.txt" (max+3)
  printfn "%s" "m=2 end."
  0

色々とひどいのはまぁ、ぎりぎりで作ったからです。
MapReduceにした理由もパッと思いついたからとか割と残念な理由だったりします。

ちょっと改善

上記コードはグラフ自体を記録していたわけではない(どの頂点がどうつながっているかという情報が欠落している)ので、グラフ情報を記録できるようにしておく。
あと、aggregateは別に再帰関数でなくてもfoldで実装できるのでリファクタリング
さらに、重複部分がいくつかあるのでそれもリファクタリング

module Barabasi

open System
open System.IO
open Microsoft.FSharp.Collections

// m=1での初期グラフ
let m1Init = [ (0,1); (0,1) ]

// m=2での初期グラフ
let m2Init = [ (0,1); (0,1); (1,2); (1,2); (2,0); (2,0) ]

// シミュレーション回数
let maxCount = 9998

let rand = new Random()

let flatten list = list |> List.fold (fun r (a,b) -> a::b::r) []

// 新たな頂点とつながる頂点を決める
let createEdge list node =
  let list = list |> flatten
  let node2 = list |> List.length |> rand.Next |> List.nth list
  (node,node2)

// データカウント型のリストを同じ頂点ごとに辞書型(ここではtupleのリスト)に集約する
let aggregate result (data,count) =
  result
  |> List.tryFind (fst >> ((=) data)) // 一致するデータをみつける
  |> Option.map (fun (data,counts) -> (data,count::counts))   // データの要素リストに個数を追加
  |> function
  | None -> (data,[count])::result
  | Some (data,counts) -> (data,counts) :: (result |> List.filter (fst >> ((<>) data)))

// 集約したデータのカウント数を足し上げて、頂点カウント型として返す非同期ワークフロー
let reduceCount (data,counts) =
  async { return (data , counts |> List.sum) }

let mapreduce list =
  list
  |> PSeq.map (fun data -> (data,1))
  |> PSeq.sort
  |> PSeq.fold aggregate []   // 集約
  |> PSeq.map reduceCount // 非同期ワークフローでカウント数の足し上げ
  |> Async.Parallel // 非同期式を並列に評価するための配列に変換
  |> Async.RunSynchronously // 非同期式を実行し、返り値を待つ

// 各頂点の出現回数を数える
let countNodes nodes = nodes |> flatten |> List.toSeq |> mapreduce

// m=1のの時のグラフの成長をシミュレート
// init : シミュレーション開始点
let execm1 init =
  Array.Parallel.init maxCount ((+) init)
  |> Array.fold (fun list node -> (node |> createEdge list) :: list) m1Init

// m=2の時のグラフの成長をシミュレート
// init : シミュレーション開始点
let execm2 init =

  Array.Parallel.init maxCount ((+) init)
  |> Array.fold begin
    fun list node ->
      let set1 = node |> createEdge list
      let set2 = node |> createEdge list
      set1 :: set2 :: list
  end m2Init

// 次数が一致する頂点の数をカウント
let countDegree list =
  list
  |> Array.unzip    // 頂点番号と次数のペアを分割する
  |> snd    // 次数のみ取得する
  |> Array.toSeq
  |> mapreduce

// P(k)を計算してファイルに書き込む
let writeData filename max list =
  use stream = new IO.FileStream(filename, FileMode.Create, FileAccess.Write)
  use writer = new StreamWriter(stream)
  list |> Array.iter (fun (node,count) ->
    let p = (decimal count) / decimal max   // P(k)の計算
    if p <> 0M then (string node) + " " + (string p) |> writer.WriteLine
  )

let simulate func init filename message =
  let start = DateTime.Now
  let max = maxCount + init
  func init |> countNodes |> countDegree |> writeData filename max
  let ed = DateTime.Now
  let time = ed - start
  printfn "%s time:%A." message time

[<EntryPoint>]
let main _ =
  // m=1についてP(k)の計算
  async {
    simulate execm1 2 @".\execm1.txt" "m=1"
  } |> Async.Start
  // m=2についてP(k)の計算
  simulate execm2 3 @".\execm2.txt" "m=2"
  0

一応、すっきり。

問題点

実行速度が遅い。
他の人に聞いたところ、N=10000程度ならそこまで実行速度は遅くないという話だが…まぁ、ベタ書き手続きには追いつけないのは仕方がない?
countNodes実行時のaggregateで時間がかかっているのは判明しているわけですが、なんかいい方法ないかなぁ…。

いいところ

問題の仕様を読み違えての失敗以外でミスが発生しなかった。
あと、テストしやすいです。