2011-05-08

デモデータの作成

R DNA鑑定

家系を与える
家系が満足するジェノタイプデータを作る
一部の家系メンバーのジェノタイプデータが欠けたデータを作る
HWEを満足する集団のジェノタイプデータを作る
候補者のジェノタイプデータを家系メンバーのうちのジェノタイプが欠けたメンバーのジェノタイプと、HWE一般集団のジェノタイプとを合わせたものとする
Gpool2から「候補者」が選ばれるものとして、それを作る
家系情報の誤り(父母の性別など)は"MakePedigreeFromFamilyInfo()"関数によってチェックしている

# 家系情報データ
# ID, mother, father, sex, status(1:available,2:searched,3:unavailable)
pedigrees<-list()
pedigrees[[1]]<-matrix(
c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
  0, 0, 0, 0, 2, 2, 4, 4, 6,  6,  0,  0, 12, 13,
  0, 0, 0, 0, 1, 1, 3, 3, 7,  7,  0,  0, 11, 10,
  0, 1, 0, 1, 0, 1, 0, 1, 0,  0,  0,  1,  1,  1,
  1,1,1,1,2,3,1,1,1,1,1,2,2,1),
  ncol=5)
# 同胞
pedigrees[[2]]<-matrix(
c(1,2,3,4,
  0,0,1,1,
  0,0,2,2,
  1,0,0,1,
  3,3,1,2),
  ncol=5)
# Trio
pedigrees[[3]]<-matrix(
c(1,2,3,
  0,0,1,
  0,0,2,
  1,0,0,
  1,3,2),
  ncol=5)
  

pedigrees[[4]]<-matrix(
c(1:8,
  0,0,1,0,3,3,3,3,
  0,0,2,0,4,4,4,4,
  1,0,1,0,1,1,0,0,
  1,1,3,3,1,1,2,1),
  ncol=5)
# 親子
pedigrees[[5]]<-matrix(
c(1,2,3,
  0,0,1,
  0,0,2,
  1,0,0,
  3,1,2),
  ncol=5)
# 親子
pedigrees[[6]]<-matrix(
c(1,2,3,
  0,0,1,
  0,0,2,
  1,0,0,
  3,1,2),
  ncol=5)
pedigrees[[7]]<-matrix(
c(1, 2, 3, 4, 5, 6, 7, 8, 
  0, 0, 0, 0, 2, 2, 4, 6,
  0, 0, 0, 0, 1, 1, 3, 7,
  0, 1, 0, 1, 1, 1, 0, 1,
  1,2,1,1,1,3,1,1),
  ncol=5)

pedigrees[[8]]<-matrix(
c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,15,16,17,18,19,
  0, 0, 0, 0, 2, 2, 4, 4, 6,  6,  0,  0, 12, 13,13,13,13,13,13,
  0, 0, 0, 0, 1, 1, 3, 3, 7,  7,  0,  0, 11, 10,10,10,10,10,10,
  0, 1, 0, 1, 0, 1, 0, 1, 0,  0,  0,  1,  1,  1,1,1,1,1,1,
  3,1,1,1,3,1,1,1,1,2,1,1,2,1,1,1,1,1,1),
  ncol=5)
pedigrees[[9]]<-matrix(
c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
  0, 0, 0, 0, 2, 2, 4, 4, 6,  6,  0,  0, 12, 13,
  0, 0, 0, 0, 1, 1, 3, 3, 7,  7,  0,  0, 11, 10,
  0, 1, 0, 1, 0, 1, 0, 1, 0,  0,  0,  1,  1,  1,
  3,1,1,1,3,1,1,1,1,2,1,1,2,1),
  ncol=5)

# 同胞
pedigrees[[10]]<-matrix(
c(1,2,3,4,
  0,0,1,1,
  0,0,2,2,
  1,0,0,1,
  3,1,1,2),
  ncol=5)
pedigrees[[11]]<-matrix(
c(1, 2, 3, 4, 5, 6, 7, 8, 
  0, 0, 0, 0, 2, 2, 4, 6,
  0, 0, 0, 0, 1, 1, 3, 7,
  0, 1, 0, 1, 1, 1, 0, 1,
  1,2,1,1,1,3,1,1),
  ncol=5)
pedigrees[[12]]<-matrix(
c(1,2,3,4,
  0,0,1,1,
  0,0,2,2,
  1,0,0,1,
  3,1,1,2),
  ncol=5)

# 家系に名前を付けておこう
FamilyNames<-list()
# 個人に名前を付けておこう
IndNames<-list()

for(ip in 1:length(pedigrees)){
	FamilyNames[[ip]]<-paste("苗字",ip,sep="")
	IndNames[[ip]]<-list()
	for(j in 1:length(pedigrees[[ip]][,1])){
		IndNames[[ip]][[j]]<-paste(FamilyNames[[ip]],j,"太郎花子")
	}
}
# Identifilerのアレルを使う
Alleles<-AllelesId
Probs<-ProbsIDYoshidaFreq2
NL<-length(Alleles)

# 家系図に合致するデータを作成
genotypesFamily<-list() # 一部欠けたデータ
genotypesFamilyFull<-list() # 全員のデータ
for(ip in 1:length(pedigrees)){
	#print(i)
	# pedigree オブジェクトを作ることで家系情報のクオリティをチェック
	tmppedigree<-MakePedigreeFromFamilyInfo(pedigrees[[ip]])
	plot(tmppedigree)
	p<-pedigrees[[ip]]

	G<-RandomGenotypeFamily(p,NL,Alleles,Probs)
	G2<-G
	G2[which(p[,5]==2),,]<-0
	G2[which(p[,5]==3),,]<-0
	genotypesFamily[[ip]]<-G2
	genotypesFamilyFull[[ip]]<-G
}
# ジェノタイププールを作成
Np<-1000 # 候補者人数

Gpool<-RandomGenotype(Np,NL,Alleles,Probs)
Npool<-length(Gpool[,1,1])
tmpNpool<-0
for(ip in 1:length(pedigrees)){
	tmpNpool<-tmpNpool+length(which(pedigrees[[ip]][,5]!=1))
	#Npool<-Npool+length(which(pedigrees[[ip]][,5]!=1))
}
Npool<-Npool+tmpNpool


Gpool2<-array(0,c(Npool,2,NL))
cnt<-1
for(ip in 1:length(pedigrees)){
	tmpG<-genotypesFamilyFull[[ip]][which(pedigrees[[ip]][,5]!=1),,]
	Gpool2[cnt:(cnt+length(tmpG[,1,1])-1),,]<-tmpG
	cnt<-cnt+length(tmpG[,1,1])
}
Gpool2[cnt:Npool,,]<-Gpool
# candidates が身元不明者のジェノタイプ以外の情報で選択されたとする。
# そのリストを与えよう
candidatesList<-list()
for(ip in 1:length(pedigrees)){
	candidatesList[[ip]]<-list()
	for(j in 1:length(pedigrees[[ip]][,1])){
		if(pedigrees[[ip]][j,5]==2){
			candidatesList[[ip]][[j]]<-c(1:tmpNpool,sample((tmpNpool+1):Npool,100))
		}else{
			candidatesList[[ip]][[j]]<-c()
		}
		
	}
}