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 ) $ [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

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

f🆔jeneshicc:20090623015750p:image