始祖比率

  • 個人の常染色体は母由来のそれと父由来のそれとの2本ある
  • 家系がある
  • 家系のジェノタイプ情報を考えるとき、ジェノタイプが判明している場合と判明していない場合がある
  • ジェノタイプが判明していない家系内メンバーであり、かつ、父母のどちらも知られていないメンバー(家系の始祖)がいるとき、通常、そのメンバーのジェノタイプは帰属集団のジェノタイプ頻度に比例して確率的に考える(これは、「そのような確率的なジェノタイプであるという情報が判明している」と言うこともできる)
  • したがって、家系全体のジェノタイプ情報は、「実際にジェノタイプが与えられているメンバー」と「不明だが、始祖なので、ジェノタイプ確率が与えられるメンバー」とが得られる
  • その他のメンバーの情報はメンデルの法則で確率的に決まる
  • したがって、「ジェノタイプ既知メンバー」と「始祖メンバー」とを、この家系のジェノタイプ決定のメンバーとし、非決定メンバーは決定メンバーのモザイクとみなして、そのモザイク比率を出すことを考えよう
  • 母由来染色体、父由来染色体を分けて考える(その方が、後々、好都合なので)
  • その前に、単純に、家系の始祖比率を
AncOff<-function(p){
	ns<-length(p[,1])
	ret<-matrix(0,ns,ns)
	for(i in 1:ns){
			tmpP1<-p[i,2]
			tmpP2<-p[i,3]
			if(tmpP1!=0){
				ret[i,tmpP1]<-ret[i,tmpP1]+0.5
			}else{
				ret[i,i]<-1
			}
			if(tmpP2!=0){
				ret[i,tmpP2]<-ret[i,tmpP2]+0.5
			}
		
		
	}
	#print(ret)
	fixcheck<-rep(0,ns)
	
	ancmembers<-which(p[,2]==0)
	fixcheck[ancmembers]<-1
	fixcheck<-apply(ret[,c(ancmembers)],1,sum)

	while(!sum(fixcheck)==(ns)){
		for(i in which(fixcheck!=1)){
			tmp<-rep(0,ns)
			for(j in 1:(ns)){
				tmp<-tmp+ret[j,]*ret[i,j]
			}
			ret[i,]<-tmp
		}
		fixcheck<-apply(ret[,c(ancmembers)],1,sum)

	}
	ret
}
FracParents3<-function(p){
	ns<-length(p[,1])
	p1<-matrix(0,ns,ns)
	p2<-p1
	for(i in 1:ns){
		if(p[i,5]!=1){
			tmpP1<-p[i,2]
			tmpP2<-p[i,3]
			if(tmpP1==0 & tmpP2==0){
				p1[i,i]<-p2[i,i]<-1
			}
			p1[i,tmpP1]<-p1[i,tmpP1]+1
			p2[i,tmpP2]<-p2[i,tmpP2]+1
		}else{
			p1[i,i]<-p2[i,i]<-1
		}
	}
	p12<-(p1+p2)/2
	fixcheck<-rep(0,ns)
	ancmembers<-which(p[,5]==1 | p[,2]==0)
	fixcheck[ancmembers]<-1
	fixcheck<-apply(p12[,c(ancmembers)],1,sum)

	while(!sum(fixcheck)==(ns)){
		for(i in which(fixcheck!=1)){
			tmp1<-tmp2<-rep(0,ns)
			for(j in 1:(ns)){
				tmp1<-tmp1+p12[j,]*p1[i,j]
				tmp2<-tmp2+p12[j,]*p2[i,j]
			}
			p1[i,]<-tmp1
			p2[i,]<-tmp2
			p12[i,]<-(p1[i,]+p2[i,])/2
		}
		fixcheck<-apply(p12[,c(ancmembers)],1,sum)
	}
	list(parent1=p1,parent2=p2,parentsPair=p12)
}


p<-matrix(
c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
  0, 0, 2, 2, 0, 0, 4,  4,  0,  0, 10, 11,
  0, 0, 1, 1, 0, 0, 5,  5,  0,  0, 9, 8,
  0, 1, 0, 1, 0, 1, 0,  0,  0,  1,  1,  1,
  3,1,3,3,3,3,1,2,3,3,2,2),
  ncol=5)

FracParents3(p)
library(kinship)
ped<-MakePedigreeFromFamilyInfo(p)
plot(ped)
  • 結果。第4世代の個人(ID8)の父方は第1世代までさかのぼれるが、母方は第2世代までなので、ID8の父母別構成比率が異なることに注目する
> FracParents3(p)
$parent1
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
 [1,]  1.0  0.0    0    0    0    0    0    0  0.0   0.0     0     0
 [2,]  0.0  1.0    0    0    0    0    0    0  0.0   0.0     0     0
 [3,]  0.0  1.0    0    0    0    0    0    0  0.0   0.0     0     0
 [4,]  0.0  1.0    0    0    0    0    0    0  0.0   0.0     0     0
 [5,]  0.0  0.0    0    0    1    0    0    0  0.0   0.0     0     0
 [6,]  0.0  0.0    0    0    0    1    0    0  0.0   0.0     0     0
 [7,]  0.0  0.0    0    0    0    0    1    0  0.0   0.0     0     0
 [8,]  0.5  0.5    0    0    0    0    0    0  0.0   0.0     0     0
 [9,]  0.0  0.0    0    0    0    0    0    0  1.0   0.0     0     0
[10,]  0.0  0.0    0    0    0    0    0    0  0.0   1.0     0     0
[11,]  0.0  0.0    0    0    0    0    0    0  0.0   1.0     0     0
[12,]  0.0  0.0    0    0    0    0    0    0  0.5   0.5     0     0

$parent2
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
 [1,] 1.00 0.00    0    0  0.0    0    0    0    0     0     0     0
 [2,] 0.00 1.00    0    0  0.0    0    0    0    0     0     0     0
 [3,] 1.00 0.00    0    0  0.0    0    0    0    0     0     0     0
 [4,] 1.00 0.00    0    0  0.0    0    0    0    0     0     0     0
 [5,] 0.00 0.00    0    0  1.0    0    0    0    0     0     0     0
 [6,] 0.00 0.00    0    0  0.0    1    0    0    0     0     0     0
 [7,] 0.00 0.00    0    0  0.0    0    1    0    0     0     0     0
 [8,] 0.00 0.00    0    0  1.0    0    0    0    0     0     0     0
 [9,] 0.00 0.00    0    0  0.0    0    0    0    1     0     0     0
[10,] 0.00 0.00    0    0  0.0    0    0    0    0     1     0     0
[11,] 0.00 0.00    0    0  0.0    0    0    0    1     0     0     0
[12,] 0.25 0.25    0    0  0.5    0    0    0    0     0     0     0

$parentsPair
       [,1]  [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
 [1,] 1.000 0.000    0    0 0.00    0    0    0 0.00  0.00     0     0
 [2,] 0.000 1.000    0    0 0.00    0    0    0 0.00  0.00     0     0
 [3,] 0.500 0.500    0    0 0.00    0    0    0 0.00  0.00     0     0
 [4,] 0.500 0.500    0    0 0.00    0    0    0 0.00  0.00     0     0
 [5,] 0.000 0.000    0    0 1.00    0    0    0 0.00  0.00     0     0
 [6,] 0.000 0.000    0    0 0.00    1    0    0 0.00  0.00     0     0
 [7,] 0.000 0.000    0    0 0.00    0    1    0 0.00  0.00     0     0
 [8,] 0.250 0.250    0    0 0.50    0    0    0 0.00  0.00     0     0
 [9,] 0.000 0.000    0    0 0.00    0    0    0 1.00  0.00     0     0
[10,] 0.000 0.000    0    0 0.00    0    0    0 0.00  1.00     0     0
[11,] 0.000 0.000    0    0 0.00    0    0    0 0.50  0.50     0     0
[12,] 0.125 0.125    0    0 0.25    0    0    0 0.25  0.25     0     0