社会を＜モデル＞でみる：数理社会学への招待
29章：なぜ差別しなくても外国人居住区ができるのか
○と♯の２つのグループが存在し、以下の条件で他の場所へ移動する。
○: 近隣に２人以下○の場合、
♯: 近隣の1/3以上が♯でない場合、

例１
#
# 1 epochで複数回移動するエージェントがいてもいいバージョン
# 次回は移動は1epoch内で最大１回とするものを作りましょう。
#

# function to check circles
ck.circle <- function(world,i_row,i_col,max.row,max.col) {
  neighbor=world[max(i_row-1,1):min(i_row+1,max.row),
                 max(i_col-1,1):min(i_col+1,max.col)]
  circles=length(which(neighbor==2))
  act=ifelse(circles<3,"move","stay")
  return(act)
}

# function to check sharps
ck.sharp <- function(world,i_row,i_col,max.row,max.col) {
  neighbor=world[max(i_row-1,1):min(i_row+1,max.row),
                 max(i_col-1,1):min(i_col+1,max.col)]
  all.neighb=length(which(neighbor!=0))-1
  if (all.neighb==0){
    return("move")
  } else {
    sharps=length(which(neighbor==1))-1
    act=ifelse(sharps/all.neighb<(1/3),"move","stay")
    return(act)
  }
}

FUNmigration<-function(N.row=10, N.col=10, N.sharp=10, N.circle=10) {
   
# initialization
world=matrix(0,nrow=N.row,ncol=N.col)
temp.vec=c(rep(1,N.sharp),rep(2,N.circle))
world[sample(1:(N.row*N.col),N.sharp+N.circle,replace=F)]=temp.vec
moved=1;counter=0

# plotting initial config.
par(mfrow=c(1,2))
idx1<-which(world==2,arr.ind=T);idx2<-which(world==1,arr.ind=T)
plot(idx1[,1],idx1[,2],type="n",xlim=c(0.5,N.row+0.5),
  ylim=c(0.5,N.col+0.5),main="Initial Arrangement",
  xlab="location @ x", ylab="location @ y")
  text(idx1[,1],idx1[,2],"o",cex=4,col="red");
  text(idx2[,1],idx2[,2],"#",cex=4,col="blue")

# main loop, max.iter=1000
while (moved>0 & counter<1000) {
  moved=0
  counter=counter+1
  for (i_row in 1:N.row) {
    for (i_col in 1:N.col) {
      if (world[i_row,i_col]==1) {
        act=ck.sharp(world,i_row,i_col,N.row,N.col)
        if (act=="move") {   
          dest=sample(which(world==0),1)
          world[dest]=1
          world[i_row,i_col]=0
          moved=1  
        }
      }
      if (world[i_row,i_col]==2) {
        act=ck.circle(world,i_row,i_col,N.row,N.col)
        if (act == "move") {
         dest=sample(which(world==0),1)
         world[dest]=2
         world[i_row,i_col]=0
         moved=1
        }
}}}}

# plotting result
idx1<-which(world==1,arr.ind=T)
idx2<-which(world==2,arr.ind=T)
plot(idx1[,1],idx1[,2],type="n",xlim=c(0.5,N.row+0.5),ylim=c(0.5,N.col+0.5),
  main="Arragement After Migration",,xlab="location @ x", ylab="location @ y")
text(idx1[,1],idx1[,2],"#",cex=4,col="blue")
text(idx2[,1],idx2[,2],"o",cex=4,col="red")
return(world)
}

例2
#
# 移動は1epoch内で最大１回とするバージョン
#

FUNmigration2<-function(N.row=10, N.col=10, N.sharp=10, N.circle=10) {
   
# initialization
world=matrix(0,nrow=N.row,ncol=N.col)
temp.vec=c(rep(1,N.sharp),rep(2,N.circle))
world[sample(1:(N.row*N.col),N.sharp+N.circle,replace=F)]=temp.vec
moved=1;counter=0

# plotting initial config.
par(mfrow=c(1,2))
idx1<-which(world==2,arr.ind=T);idx2<-which(world==1,arr.ind=T)
plot(idx1[,1],idx1[,2],type="n",xlim=c(0.5,N.row+0.5),
  ylim=c(0.5,N.col+0.5),main="Initial Arrangement",
  xlab="location @ x", ylab="location @ y")
  text(idx1[,1],idx1[,2],"o",cex=4,col="red");
  text(idx2[,1],idx2[,2],"#",cex=4,col="blue")

ck.circle <- function(world,i_row,i_col,max.row,max.col) {
  neighbor=world[max(i_row-1,1):min(i_row+1,max.row),
                 max(i_col-1,1):min(i_col+1,max.col)]
  circles=length(which(neighbor<0))
  act=ifelse(circles<3,"move","stay")
  return(act)
}
 
ck.sharp <- function(world,i_row,i_col,max.row,max.col) {
  neighbor=world[max(i_row-1,1):min(i_row+1,max.row),
                 max(i_col-1,1):min(i_col+1,max.col)]
  all.neighb=length(which(neighbor!=0))-1
  if (all.neighb==0){
    return("move")
  } else {
    sharps=length(which(neighbor>0))-1
    act=ifelse(sharps/all.neighb<(1/3),"move","stay")
    return(act)
  }
}

# ここから違う
moved=1;counter=0;N.row=10;N.col=10;
while (moved>0 & counter<1000) {
  moved=0
  counter=counter+1
  for (i_sharp in 1:N.sharp) {
    idx=which(world==i_sharp,arr.ind=T)
    act=ck.sharp(world,idx[1],idx[2],N.row,N.col);
    if (act=="move") {   
      dest=sample(which(world==0),1)
      world[dest]=i_sharp
      world[idx[1],idx[2]]=0
      moved=1  
    }
  }
  for (i_circle in -1:-N.circle) {
    idx=which(world==i_circle,arr.ind=T)
    act=ck.circle(world,idx[1],idx[2],N.row,N.col);
    if (act=="move") {   
      dest=sample(which(world==0),1)
      world[dest]=i_circle
      world[idx[1],idx[2]]=0
      moved=1  
    }  
  }
} 

# plotting result
idx1<-which(world==1,arr.ind=T)
idx2<-which(world==2,arr.ind=T)
plot(idx1[,1],idx1[,2],type="n",xlim=c(0.5,N.row+0.5),ylim=c(0.5,N.col+0.5),
  main="Arragement After Migration",,xlab="location @ x", ylab="location @ y")
text(idx1[,1],idx1[,2],"#",cex=4,col="blue")
text(idx2[,1],idx2[,2],"o",cex=4,col="red")
return(world)
}