BAモデルはスケールフリーのネットワークを生成する手順．

レポートで使うので，実装してみた．

しかし，非決定的だから，何とも．

そして，面倒なので非効率的実装になっている．あしからず．

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

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