Generic AlgorithmでPDGやってみる(習作1)

GA_PDG_primitive

# 囚人のジレンマ関数をつくる
PDG.rule <- function(A,B){
  if(A ==1 && B == 1){ payA <-  8; payB <-  8 }
  if(A ==0 && B == 1){ payA <- 12; payB <-  0 }
  if(A ==1 && B == 0){ payA <-  0; payB <- 12 }
  if(A ==0 && B == 0){ payA <-  4; payB <-  4 }
  return(list(A=payA,B=payB))
}

PDG.rule(0,1)

# 遺伝的アルゴリズムで遊ぶ
world <- list()
# 初期化
player <- data.frame(matrix(rbinom(20*100,1,0.9),nrow=100))
player$ritoku <- NA

next.gen <- data.frame(matrix(NA,nrow=100,ncol=20))

world[[1]] <- player

for(generation in 1:100){
  # マッチメイク
  match <- sample(1:100,100)
  p <- seq(1,100,2)
  for(set in 1:50){
    A <- match[p[set]]
    B <- match[p[set]+1]
    ritokuA <- 0
    ritokuB <- 0
    optionA <- world[[generation]][A,]
    optionB <- world[[generation]][B,]
    for(j in 1:20){
      ritokuA <- ritokuA + PDG.rule(optionA[j],optionB[j])$A
      ritokuB <- ritokuB + PDG.rule(optionA[j],optionB[j])$B
    }
    world[[generation]]$ritoku[A] <- ritokuA
    world[[generation]]$ritoku[B] <- ritokuB
  }
  
  # 世代交代
  survive <- order(world[[generation]]$ritoku,decreasing = T)[1:10]
  print(summary(world[[generation]]$ritoku))
  next.gen[1:10,] <- world[[generation]][survive,1:20]
  # 交配/二点交叉
  for(i in 11:100){
    pair <- sample(survive,2)
    father <- world[[generation]][pair[1],]
    mother <- world[[generation]][pair[2],]
    child <- cbind(father[,1:5],mother[,6:15],father[,16:20])
    next.gen[i,] <- child
  }
#  突然変異
  mp <- sample(11:100,4)
  for(i in 1:4){
    st <- round(runif(2,1,20))
    st <- st[order(st)]
    st
    next.gen[mp[i],st[1]:st[2]] <- 1-next.gen[mp[i],st[1]:st[2]]
  }
  next.gen$ritoku <- NA
  world[[generation+1]] <- next.gen
}