数理社会学:なぜ差別しなくても外国人居住区ができるのか

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

# 1 epochの内、数回移動する可能性のある場合
FUNmigration<-function(field_size=6, Nsharp=10, Ncircle=10) {
  
Nempty=(field_size^2-Nsharp-Ncircle)
society<-matrix(sample(c(rep(0,Nempty),rep(1,Ncircle),rep(2,Nsharp))),ncol=field_size)
# plotting initial config.
par(mfrow=c(1,2))
idx1<-which(society==1,arr.ind=T);idx2<-which(society==2,arr.ind=T)
plot(idx1[,1],idx1[,2],type="n",xlim=c(0.5,field_size+0.5),
  ylim=c(0.5,field_size+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 
moved=1;counter=0
while (moved>0&counter<1000) {
  counter=counter+1;moved=0
  for (i_row in 1:field_size) {
    for (i_col in 1:field_size) {
      # checking sharps
      if (society[i_row,i_col]==2) {
        neR_IDX=max((i_row-1),1):min((i_row+1),field_size);
        neC_IDX=max((i_col-1),1):min((i_col+1),field_size);
        n_sharp=sum(society[neR_IDX,neC_IDX]==2)-1;
        n_circle=sum(society[neR_IDX,neC_IDX]==1);
        if (n_sharp+n_circle==0 | n_sharp/(n_sharp+n_circle) < (1/3)) {
          moved=moved+1;
          loc_mov=sample(which(society==0),1)
          society[i_row,i_col]=0
          society[loc_mov]=2
        }
      }
      # checking circles
     if (society[i_row,i_col]==1) {
       neR_IDX=max((i_row-1),1):min((i_row+1),field_size);
       neC_IDX=max((i_col-1),1):min((i_col+1),field_size);
       n_circle=sum(society[neR_IDX,neC_IDX]==1)-1;
       if (n_circle < 3) {
         moved=moved+1;
         loc_mov=sample(which(society==0),1)
         society[i_row,i_col]=0
         society[loc_mov]=1
        }
      }
    }
  }
}
# plotting final config.
idx1<-which(society==1,arr.ind=T)
idx2<-which(society==2,arr.ind=T)
plot(idx1[,1],idx1[,2],type="n",xlim=c(0.5,field_size+0.5),ylim=c(0.5,field_size+0.5),
  main="Arragement After Migration",,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")
}
# 1 epochの内、1度のみ移動する場合
FUNmigration <- function(soc.size = 6, n.circle = 10, n.sharp = 10) {
  r.sample = sample(soc.size ^ 2)
  society = matrix(0, soc.size, soc.size)
  society[r.sample[1:n.circle]] = 1
  society[r.sample[(n.circle + 1):(n.circle + n.sharp)]] = 2
  
  # plotting initial config.
  par(mfrow = c(1, 2))
  idx1 <- which(society == 1, arr.ind = T)
  idx2 <- which(society == 2, arr.ind = T)
  plot(idx1[, 1], idx1[, 2], type = "n", xlim = c(0.5, soc.size + 0.5),
    ylim = c(0.5, soc.size + 0.5), main = "Initial Arrangement",
    xlab = "location @ x", ylab = "location @ y")
  text(idx1[, 1], idx1[, 2], "o", cex = 3, col = "red")
  text(idx2[, 1], idx2[, 2], "#", cex = 3, col = "blue")
  move = 1
  while (move != 0 ) {
    # circles
    move = 0
    c.pos = which(society == 1, arr.ind = T)
    for (i.c in 1:n.circle) {
      r.idx = c(max(1, c.pos[i.c, 1] - 1), min(soc.size, c.pos[i.c, 1] + 1))
      c.idx = c(max(1, c.pos[i.c, 2] - 1), min(soc.size, c.pos[i.c, 2] + 1))
      neighber  = society[r.idx[1]:r.idx[2], c.idx[1]:c.idx[2]]
      neighber.c = sum(neighber == 1) - 1
      if (neighber.c < 3) {
        move = 1
        move.idx = which(society == 0)
        society[sample(move.idx, 1)] = 1
        society[c.pos[i.c, 1], c.pos[i.c, 2]] = 0
      }
    }
    # sharps
    s.pos = which(society == 2, arr.ind = T)
    for (i.s in 1:n.sharp) {
      r.idx = c(max(1, s.pos[i.s, 1] - 1), min(soc.size, s.pos[i.s, 1] + 1))
      c.idx = c(max(1, s.pos[i.s, 2] - 1), min(soc.size, s.pos[i.s, 2] + 1))
      neighbor  = society[r.idx[1]:r.idx[2], c.idx[1]:c.idx[2]]
      neighbor.s = sum(neighbor == 2) - 1
      neighbor.all = sum(neighbor != 0) - 1
      prop.s = max(0, neighbor.s / neighbor.all, na.rm = T)
      if (prop.s < 1 / 3) {
        move = 1
        move.idx = which(society == 0)
        society[sample(move.idx, 1)] = 2
        society[s.pos[i.s, 1], s.pos[i.s, 2]] = 0
      }
    }
  }
  idx1 <- which(society == 1, arr.ind = T)
  idx2 <- which(society == 2, arr.ind = T)
  plot(idx1[, 1], idx1[, 2], type = "n",
    xlim = c(0.5, soc.size + 0.5), ylim = c(0.5, soc.size + 0.5),
    main = "Arragement After Migration", xlab = "location @ x", ylab = "location @ y")
  text(idx1[, 1], idx1[, 2], "o", cex = 3, col = "red")
  text(idx2[, 1], idx2[, 2], "#", cex = 3, col = "blue")
}

Leave a Reply