DNAのサンプリングとタイピング:法廷用ベイジアンネットワーク

サンプルの取り違え、タイピングエラーを考慮して、標本のジェノタイプ実験結果から、個人の真のジェノタイプの事後確率を算出する
２人p1,p2居る。２つのジェノタイプがある。
２人からDNAタイピング用のサンプルを採取する。丁寧に取り扱っているので、取り違えの確率は低いが、その確率がゼロではないとする
p1からのサンプルのつもりでサンプルを取り出し、それについてジェノタイプを決める実験をして、ジェノタイプが観察されたとする
観察ジェノタイプは２種類のうちのどちらかである
サンプルの観察ジェノタイプと真のサンプルのジェノタイプは良く相関するが、完璧な対応関係ではないとする
サンプルの観察ジェノタイプが与えられたときに、２人の真のジェノタイプの事後確率を計算しよう

#　２人のそれぞれのノードを用意し、それぞれが1/0の値を取る確率を与えておく(この作業は、後々のため)
ps <- list()
ps[[1]] <- cptable(~p1,values=c(1,99),levels=c("1","0"))
ps[[2]] <- cptable(~p2,values=c(99,1),levels=c("1","0"))
# ２人の真のジェノタイプの確率は、情報が無ければ集団の頻度情報で決まる
Gs <- list()
Gs[[1]] <- cptable(~G1,values=c(0.0001,0.9999),levels=c("1","2"))
Gs[[2]] <- cptable(~G2,values=c(0.0001,0.9999),levels=c("1","2"))
# 標本を取り出し、その真のジェノタイプの確率決める。p1の標本のつもりで取り出すので、きちんとp1を取り出す確率と間違ってp2を取り出す確率とを考慮すると、標本の真のジェノタイプ確率が計算できる
Sx <- cptable(~Sx|G2:G1,values=c(1,0,0.999999,0.000001,0.0000001,0.999999,0,1),levels=c("1","2"))
# 標本のジェノタイプを実験で観察した結果は、標本の真のジェノタイプと実験精度で決まる
SGx <- cptable(~SGx|Sx,values=c(0.9999999,0.0000001,0.0000001,0.9999999),levels=c("1","2"))
#SGx <- cptable(~SGx|Sx,values=c(1,0,0,1),levels=c("1","2"))
# ベイジアンネットワークを作る
plist <- compileCPT(list(ps[[1]],ps[[2]],Gs[[1]],Gs[[2]],Sx,SGx))
net1 <- grain(plist)

querygrain(net1,nodes=c("p1","p2","G1","G2","Sx","SGx"))
# 標本観察ジェノタイプをエビデンスとして与える
net2 <- setEvidence(net1,nodes=c("SGx"),states=c("1"))
querygrain(net2,nodes=c("p1","p2","G1","G2","Sx","SGx"))

結果として、p1の真のジェノタイプとp2の真のジェノタイプの事後確率が集団のそれから変化していることがわかる

> querygrain(net2,nodes=c("p1","p2","G1","G2","Sx","SGx"))
$p1
p1
   1    0 
0.01 0.99 

$p2
p2
   1    0 
0.99 0.01 

$G1
G1
           1            2 
0.9990009979 0.0009990021 

$G2
G2
        1         2 
0.0001001 0.9998999 

$Sx
Sx
           1            2 
0.9990010978 0.0009989022