近親関係をグラフに持たせる

• 昨日の続き
• 昨日は、個体に空間を移動させて、そのうえで、空間的に近い個体間でメイティングを生じさせた。また、世代を隔絶した
• 今日は、メイティングのルールとして、近親関係と世代とを併せて使うことを考える
• 近親婚の禁止は世界的に認められるルールである。また、同一個体からのクローンが生まれないのも、(純粋な)有性生殖を採用しているヒトでは起きえない(クローン技術の使用は許可しないものとする)
• このとき、遺伝的な近さが０のペアからは子が生まれず、遺伝的近さが近すぎると、子は生まれにくく、遺伝的に遠い方が生まれやすいが、あまりに遠いと、それは、空間的に近くに居ないから、やはり生まれにくい、と、そんな具合になっている。以下の図は横軸が遺伝的な近さ、縦軸が、メイティング確率

• また、世代をまたがったメイティングも起きえるが、「寿命」があるので、極端なことは無理。このあたりを、年齢が下がるほどメイティング確率が上がるという設定で組み込んでみた

library(igraph)
n.init <- 2
g <- graph.empty(n.init,directed=FALSE)

birth <- rep(1,n.init)

k <- 2

Loc <- matrix(rnorm(n.init*k),ncol=k)

n.iter <- 6

my.dist <- function(x,a=0.0001){
	exp(-(x+1/x))+a
}
plot(my.dist(seq(from=0,to=10,length=1000)),type="l")
r <- 1.0001

for(i in 1:n.iter){
	v.n <- vcount(g)
	sh <- shortest.paths(g)
	d <- my.dist(sh)
	diag(d) <- 0
	t.dist <- birth %*% t(birth)
	prob <- d * t.dist
	prob <- prob/sum(prob)
	#print(prob)
	num.child <- sample(2:(v.n*5),1,prob = dpois(2:(v.n*5),v.n*r))
	parents.number <- sample(1:length(d),num.child,replace=TRUE,prob = prob)
	address <- matrix(1:length(d),v.n,v.n)
	parents.list <- which(address <= max(address),arr.ind=TRUE)
	g <- add.vertices(g,num.child)
	print(g)
	tmp <- c()
	#print(parents.number)
	for(j in 1:length(parents.number)){
		tmp <- c(tmp, parents.list[parents.number[j],1], j+v.n,  parents.list[parents.number[j],2],j+v.n)
	}
	#attributes(tmp) <- NULL
	g <- add.edges(g,tmp-1)
	#plot(g)
	birth <- c(birth,rep(i+1,num.child))
}
plot(g, layout=layout.circle, vertex.color="green")
#plot(g, layout=layout.kamada.kawai, vertex.color="green")