mle2 /最尤法を使用して推定された打ち切り二項モデルの予測の95％信頼区間

私は、現在世代の男性のペアが複数ありi、それぞれが父系の祖先と推定されるni世代が（世代別の証拠に基づいて）前にあり、Y染色体の遺伝子型にミスマッチがあるかどうかについて情報を持っています（排他的に父系で）遺伝性の、xi=不一致の場合は1、一致する場合は0）。不一致がない場合、彼らは確かに共通の父方の祖先を持っていますが、存在する場合、1つ以上の婚外事件の結果としてチェーンにキンクがあったに違いありません（私は、何もないか、少なくともそのようなエクストラペアの親子関係のイベントの1つが発生しました（つまり、従属変数が打ち切られます）。私が興味を持っているのは、平均のペア外父系（EPP）率（世代ごとに子供がペア外交尾から得られる確率）だけでなく、最尤推定（プラス95％信頼限界）を取得することですが、また、ペアの親の父親率が時間の関数としてどのように変化したかを推測することも試みます（共通の父親の祖先を分離した世代のnrがこれに関する情報を持っているはずです-不一致がある場合、私はしません）推定祖先の世代と現在の間のどこかにある可能性があるため、EPPがいつ発生したかはわかりませんが、一致する場合は、前の世代のいずれにもEPPがなかったことを確認します）。したがって、従属二項変数と独立共変量生成/時間の両方が検閲されます。投稿されたやや類似した問題に基づくここで、私は次のようにして、母の最尤推定値と時間平均のエクストラペアの父性率にphat加えてRの95％プロファイル尤度信頼区間をどのように作成できるかをすでに理解しました。

# Function to make overall ML estimate of EPP rate p plus 95% profile likelihood confidence intervals, 
# taking into account that for pairs with mismatches multiple EPP events could have occured
#
# input is 
#     x=vector of booleans or 0 and 1s specifying if there was a mismatch or not (1 or TRUE = mismatch)
#     n=vector with nr of generations that separate common ancestor
# output is mle2 maximum likelihood fit with best-fit param EPP rate p

estimateP = function(x, n) {
  if (!is.logical(x[[1]])) x = (x==1)
  neglogL = function(p, x, n)  -sum((log(1 - (1-p)^n))[x]) -sum((n*log(1-p))[!x]) # negative log likelihood, see see /stats/152111/censored-binomial-model-log-likelihood
  require(bbmle)
  fit = mle2(neglogL, start=list(p=0.01), data=list(x=x, n=n))
  return(fit)
}

いくつかのパイロットデータの例（Larmuseau et al。ProcB 2010から）：

n = c(7, 7, 7, 7, 7, 8, 9, 9, 9, 10, 10, 10, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 13, 13, 13, 13, 15, 15, 16, 16, 16, 16, 17, 17, 17, 17, 17, 17, 18, 18, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 23, 23, 24, 24, 25, 27, 31) # number of generations/meioses that separate presumed common paternal ancestor
x = c(rep(0,6), 1, rep(0,7), 1, 1, 1, 0, 1, rep(0,20), 1, rep(0,13), 1, 1, rep(0,5)) # whether pair of individuals had non-matching Y chromosomal genotypes

母集団の最尤推定値と時間平均のペア外父系率に95％信頼限界を加えたもの：

fit = estimateP(x,n)
c(coef(fit),confint(fit))*100 # estimated p and profile likelihood confidence intervals
#           p     2.5 %    97.5 % 
#   0.9415172 0.4306652 1.7458847

つまり、すべての子供の0.9％[0.43-1.75％95％CLs]は、想定された父親とは異なる父親に由来していました。

次に、さらに一歩進んで、p世代の関数としてのペア外の父親率の考えられる時間的傾向を推定しようとしましたni（ペアの親子関係のイベントを観察するログオッズと世代）、ミスマッチが発生した場合、EPPイベントは共通の祖先のni世代と現在（ジェネレーション0）の間のどこかで発生する可能性があり、ミスマッチがない場合はEPPイベントが発生しなかったことを考慮に入れますその特定の個人のペアの以前の世代のいずれか。

前に、対外交尾から子が派生する確率を一定であると想定し、Y染色体の不一致が観察されたときにがに等しい確率変数であった場合（1つ以上のEPPイベントに対応）およびそうでない場合、父方の祖先が世代前に住んでいたときに（）ミスマッチがないこと（つまり）が観察される確率はでしたが、 EPPイベントの観察は$p$$X$$1$$0$$X=0$$n$$n = 1, 2, 3, \ldots$$(1-p)^n$

$$\Pr(X=1\,|\, n) = 1 - (1-p)^n.$$

世代前に生きている父方の祖先を持つの独立した観測のデータセットでは、その可能性は$\mathbf{x} = (x_1, x_2, \ldots)$$X$$\mathbf{n} = (n_1, n_2, \ldots)$

$$L(p; \mathbf{x}, \mathbf{n}) = \prod_{x_i=1} \left(1 - (1-p)^{n_i}\right)\prod_{x_j=0} (1-p)^{n_j},$$

その結果、対数尤度になります

$$\Lambda(p) = \sum_{x_i=1} \log\left(1 - (1-p)^{n_i}\right) + \sum_{x_j=0} {n_j} \log (1-p).$$

私のより複雑なモデルでは、私が欲しい時間的ダイナミクス組み込むことを考慮すると機能する今、と 、すなわち $p$$n$

$$log (p/(1-p)) = a + b.n$$ $$p(a,b,n) = \exp(a+b.n) / (1+\exp(a+b.n))$$

次に、上記の尤度関数の定義を適宜変更し、mle2packageのfunction を使用して最大化しましたbbmle。

# ML estimation, assuming that EPP rate p shows a temporal trend
# where log(p/(1-p))=a+b*n
# input is 
#     x=vector of booleans or 0 and 1s specifying if there was a mismatch or not (1 or TRUE = mismatch)
#     n=vector with nr of generations that separate common ancestor
# output is mle2 maximum likelihood fit with best-fit params a and b

estimatePtemp = function(x, n) {
  if (!is.logical(x[[1]])) x = (x==1)
  pfun = function(a, b, n) exp(a+b*n)/(1+exp(a+b*n)) # we now write p as a function of a, b and n
  logL = function(a, b, x, n)  sum((log(1 - (1-pfun(a, b, n))^n))[x]) + 
    sum((n*log(1-pfun(a, b, n)))[!x]) # a and b are params to be estimated, modified from /stats/152111/censored-binomial-model-log-likelihood
  neglogL = function(a, b, x, n)  -logL(a, b, x, n) # negative log-likelihood
  require(bbmle)
  fit = mle2(neglogL, start=list(a=-3, b=-0.1), data=list(x=x, n=n))
  return(fit)
}

# fitted coefficients
estfit = estimatePtemp(x, n)
cbind(coef(estfit),confint(estfit)) # parameter estimates and profile likelihood confidence intervals
#                      2.5 %      97.5 %
#   a -3.09054167 -5.3191406 -1.12078519
#   b -0.09870851 -0.2396262  0.02848305
summary(estfit)
# Coefficients:
#      Estimate Std. Error z value    Pr(z)   
#   a -3.090542   1.057382 -2.9228 0.003469 **
#   b -0.098709   0.067361 -1.4654 0.142819   

これにより、時間の経過に伴うEPPレート進化の歴史的な見積もりが合理的にわかります。$p$

pfun = function(a, b, n) exp(a+b*n)/(1+exp(a+b*n)) 
xvals=1:max(n)
par(mfrow=c(1,1))
plot(xvals,sapply(xvals,function (n) pfun(coef(estfit)[1], coef(estfit)[2], n)), 
     type="l", xlab="Generations ago (n)", ylab="EPP rate (p)")

ただし、このモデルの全体的な予測で95％の信頼区間を計算する方法については、まだ少し行き詰まっています。誰かが偶然それを行う方法を知っていますか？多分母集団予測間隔を使用する（多変量正規分布に従う適合に従ってパラメーターをリサンプリングすることによって）（またはデルタ法も機能するでしょうか？）？そして、誰かが私の上のロジックが正しいかどうかコメントできますか？また、この種の検閲された二項モデルが文献の標準的な名前で知られているのか、この種のモデルでこの種のML計算を行うことに関する公開された研究を誰か知っているのかと思っていました。（私は問題がかなり標準的であり、すでに行われた何かに対応するはずであると感じていますが、何かを見つけることができないようです...）

[このトピック/問題に関するより多くの背景を持つPS論文は、こことここにあります]

上記のベンボルカーの章とコメントに基づいて、最終的に、95％の人口予測区間は次の式で与えられると考えました。

# predicted EPP rate p as a function of n (nr of generations ago)
# plus 95% population prediction intervals (cf chapter B. Bolker)
pfun = function(a, b, n) exp(a+b*n)/(1+exp(a+b*n)) # model prediction
xvals=1:max(n)
set.seed(1001)
library(MASS)
nresamp=100000
pars.picked = mvrnorm(nresamp, mu = coef(estfit), Sigma = vcov(estfit)) # pick new parameter values by sampling from multivariate normal distribution based on fit
yvals = matrix(0, nrow = nresamp, ncol = length(xvals))
for (i in 1:nresamp) {
  yvals[i,] = sapply(xvals,function (n) pfun(pars.picked[i,1], pars.picked[i,2], n))
}
quant = function(col) quantile(col, c(0.025,0.975)) # 95% percentiles
conflims = apply(yvals,2,quant) # 95% confidence intervals

par(mfrow=c(1,1))
plot(xvals, sapply(xvals,function (n) pfun(coef(estfit)[1], coef(estfit)[2], n)), 
     type="l", xlab="Generations ago (n)", ylab="EPP rate (p)", ylim=c(0,0.05))
lines(xvals, conflims[1,], col="red" , lty=2)
lines(xvals, conflims[2,], col="red" , lty=2)