数理社会学:なぜ社会は狭いのか?

ネットワークの作成方法の例と距離の測りかた
Regular Networks, Small-World Networks

mkRegG=function(n_node,n_edge){
# input
# n_node: number of nodes
# n_edge: number of edges / 2  
  M=matrix(0,n_node,n_node) 
  for (i_loop in 1:n_edge){
    M=M+diag(1,n_node,n_node)[, c((i_loop+1):n_node,1:i_loop)]
  }
  return(M+t(M))
}

# small-world network
G=mkRegG(100,2);
n_node=ncol(G);
prob=0.05;
for (i_node in 1:n_node) {
  node=G[i_node,]
  linked=which(node==1) 
  woLinked=which(node==0) 
  woLinked=woLinked[woLinked!=i_node]
  rwVec=linked[which(runif(length(linked)) < prob)]
  nRW=length(rwVec)
  if (nRW>0) {
    newLink=sample(woLinked,nRW)
    G[i_node,newLink]=1;G[newLink,i_node]=1
    G[i_node,rwVec]=0;G[rwVec,i_node]=0
  }
}  

# cal. shortest path
dijkstra2<-function(G,nodeID){
n_node=nrow(G)
G[which(G==0)]=Inf;diag(G)=0
d=rep(Inf,n_node);d[nodeID]=0
M=1:n_node;M=M[-nodeID]
while(length(M)>0) {
  for (j in 1:n_node) 
    {
      d[j]=min(d[j],d[nodeID]+G[nodeID,j])
    }
    nodeID=M[which(d[M]==min(d[M]))]
    n_remove=length(nodeID)
    for (i_remove in 1:n_remove){
      M=M[-which(M==nodeID[i_remove])]
    }
  }
 return(d)
}

昔のバージョン(多分)

# regular network 
mkRegG=function(n_node,n_edge){
# input
# n_node: number of nodes
# n_edge: number of edges / 2  
  M=matrix(0,n_node,n_node)	
  for (i_loop in 1:n_edge){
    M=M+diag(1,n_node,n_node)[, c((i_loop+1):n_node,1:i_loop)]
  }
  return(M+t(M))
}
# WS model (small-world)
mkWSG=function(regG,prob){
# input
# regG: regular network
# prob: probability of rewiring / 2
n_node=ncol(regG)
M=regG;
  for (i_node in 1:n_node){
    edge=which(M[i_node,]==1)
    rwVec=edge[which(runif(length(edge)) < prob)]
    nRW=length(rwVec);
    if (nRW>0) {
      newEdge=sample(seq(n_node)[-i_node],nRW);
      while (any(M[i_node,newEdge]==1) & any(M[i_node,rwVec]==1)){
        newEdge=sample(seq(n_node)[-i_node],nRW);
    }
    M[i_node,newEdge]=1;M[newEdge,i_node]=1;
    M[i_node,rwVec]=0;M[rwVec,i_node]=0;	
    }
  }
  return(M);
}
# scale-free network
mkFSG=function(n_node,n_edge) {
# input
# n_node: number of nodes
# n_edge: minimum number of edges
  M=matrix(1,n_edge+1,n_edge+1)-diag(n_edge+1)
  for (i_node in (n_edge+2):n_node) {
    Pnode=rowSums(M)/sum(M)	
    cumPnode=c(0,cumsum(Pnode))
    vec=matrix(0,1,i_node-1)
      while (sum(vec) < n_edge) {
        vec[max(which(cumPnode<=runif(1)))]=1
      }
    M=rbind(M,vec);
    M=cbind(M,c(vec,0));
  }
  return(M)
}

CLT simulation

中央極限定理の実験

source("http://peach.l.chiba-u.ac.jp/course_folder/ckCLT.txt")

# r command
genR<-function(n_rep,n_sample,prob,distID){
switch(distID,
  binom=rbinom(n_sample*n_rep,n_sample,prob),
  normal=rnorm(n_rep*n_sample),
  uniform=runif(n_rep*n_sample))
}
ckCLT=function(n_rep,n_sample,prob,Distr){
  vecR<-genR(n_rep,n_sample,prob,Distr)
  dat<-matrix(vecR,nrow=n_rep,ncol=n_sample);
  means<-rowMeans(dat)
  par(mfrow=c(2,1))
  hist(vecR,main="Dist. of the original data set")
  hist(means,main="Dist. of sample meanx",xlab="sample mean",probability=T)
  if (Distr=="binom"){
    denS=density(means,bw=0.125)
  } else {denS=density(means)}
  lines(denS,col='blue',lwd=2)
 return(means);
}