ディプロタイプの事前確率を考慮する

• 核家族ごとに、取りうるディプロタイプの組み合わせごとに確率を計算することを前記事で書いた
• ディプロタイプがわかっている人の場合は、ただ１つのディプロタイプが確率１で決まっている
• ディプロタイプが与えられていないメンバーの場合、親が不明な場合には、「帰属集団」が両親であるとみなす。家系につながっているから、その情報からとりうるディプロタイプは限定される。その限定の範囲で「貴族集団」のディプロタイプ頻度を反映させる
• 家系の中に組み込まれているメンバーで、ディプロタイプが未確定の場合は、周囲の具合によって決まるので、すべての取りうるディプロタイプは等しく扱う
• ディプロタイプが確定しているメンバーというのは、その特定のディプロタイプを取る確率が１であることを意味していると考える
• 家系メンバーの取りうるディプロタイプを探索するにあたって、ディプロタイプが確定していなかったメンバーについて、相変わらず「未確定」のものはそのまま、確定したものは、そのディプロタイプの確率が１でそれ以外のディプロタイプの確率は０とする
• 取りうるディプロタイプを調べるときに用いたディプロタイプ情報がgであり、その後、一部の個人のディプロタイプ情報が追加されるとき(特定のサンプルをディプロタイプ不明の個人に当て嵌めて計算したいとき)にディプロタイプをgnewとして与えることを考える

MakeInfo<-function(LDZout,gnew){
	ret<-LDZout$dlistA
	unknown="0"
	for(i in 1:length(gnew[,1])){
		if(gnew[i,1]!=unknown){
			ret[[i]]<-list(as.set(gnew[i,]))
		}
	}
	ret
}

gnew<-g
gnew[10,]<-c("17","15")
info<-MakeInfo(LDZout,gnew)

MakeDiplotypePrior<-function(p,g,A,P,LDZout,info){
	ret<-list()
	for(i in 1:length(p[,1])){
		ret[[i]]<-rep(1,length(LDZout$dlist[[i]]))
		#print(ret[[i]])
		if(length(info[[i]])>1){
			if(p[i,2]=="0"){
				tmph1<-LDZout$hset1A[[i]]
				tmph2<-LDZout$hset2A[[i]]
				
				for(j in 1:length(LDZout$dlist[[i]])){
					tmpp<-1
					#print(LDZout$dlistA[[i]][[j]])
					heterocheck<-TRUE
					for(k in LDZout$dlistA[[i]][[j]]){
						#print(k)
						if(!(k %e% (tmph1 & tmph2)))heterocheck<-FALSE
						tmpp<-tmpp*P[which(A==k)]
					}

					if(length(LDZout$dlistA[[i]][[j]])==2){
						if(heterocheck){
							#print("heterocheck")
					#print(heterocheck)
							tmpp<-tmpp*2	
						}
					}
					
					ret[[i]][j]<-tmpp
				}
				ret[[i]]<-ret[[i]]/sum(ret[[i]])
			}

			
		}else{
			ret[[i]]<-rep(0,length(LDZout$dlist[[i]]))
			for(j in 1:length(LDZout$dlist[[i]])){
				#print(info[[i]])
				#print(LDZout$dlistA[[i]][[j]])
				if(info[[i]][[1]] == LDZout$dlistA[[i]][[j]]){
					ret[[i]][j]=1
				}
			}
		}
	}
	ret
}

DiplotypePrior<-MakeDiplotypePrior(p,g,A,P,LDZout,info)