BA (Barabasi-Albert) モデル

BAモデルはスケールフリーのネットワークを生成する手順．
レポートで使うので，実装してみた．
Haskellで．
多分，正しいはず．（多分）
しかし，非決定的だから，何とも．
そして，面倒なので非効率的実装になっている．あしからず．

import Data.List (sort, group, groupBy, findIndex, nub)
import Data.Graph.Inductive (Gr, Node, mkUGraph, insEdges, insNode, nodes, edges, outdeg, suc)
import Data.Function (on)
import System.Random (mkStdGen, randoms)

-- runhaskell BA_Model.hs | dot -Teps > BA.eps

main :: IO ()
main = mapM_ (\ (x,y) -> putStrLn $ show x ++ " " ++ show y).adjDegDist $ mkBANetwork 555 6 5
--main = mapM_ (\ (x,y) -> putStrLn $ show x ++ " " ++ show y).degDist' $ mkBANetwork 555 6 5

completeGraph :: Int -> Gr () ()
completeGraph n = mkUGraph [1..n] [(i,j) | i <- [1..n], j <- [1..n], i /= j ]

insComponent :: Int -> [Int] -> Gr () () -> Gr () ()
insComponent n ns g = insEdges es $ insNode (n,()) g
    where es = concat [[(n,m,()), (m,n,())] | m <- ns]

degDist :: Gr () () -> [Double]
degDist g = [on (/) fromIntegral (outdeg g n) (length.edges $ g) | n <- nodes g]

selectNode :: Gr () () -> Double -> Node
selectNode g p = maybe 1 (+1).findIndex (>p).scanl1 (+).degDist $ g

mkBANetwork :: Int -> Int -> Int -> Gr () ()
mkBANetwork s m0 m = fst.foldl grow (completeGraph m0, randoms  $ mkStdGen 0) $ [m0+1..s]
    where grow :: (Gr () (), [Double]) -> Int -> (Gr () (),[Double])
          grow (g, rs) n = let ns = nub.map (selectNode g).take m $ rs
                           in (insComponent n ns g, drop m rs)

adjDegDist :: Gr () () -> [(Int, Double)]
adjDegDist g = sort.ave.groupBy (on (==) fst).sort $ [(outdeg g n, sum.map (outdeg g).suc g $ n) | n <- nodes g]
    where ave' ns = on (/) fromIntegral (sum.map snd $ ns) (sum.map fst $ ns)
          ave = map (\xs -> (fst.head $ xs, ave' xs))

degDist' :: Gr () () -> [(Int, Int)]
degDist' g = map (\xs -> (head xs, length xs)).group.sort.map (outdeg g).nodes $ g

なーんか，次数分布がベキ則に従ってないような…