95% -Konfidenzintervalle bei Vorhersage des zensierten Binomialmodells, geschätzt unter Verwendung von mle2 / Maximum-Likelihood

Ich arbeite an einem Problem, bei dem ich mehrere Paare derzeit lebender Männer habe i, von denen jedes vor niGenerationen einen vermuteten väterlichen Vorfahren hat (basierend auf genealogischen Beweisen) und bei denen ich Informationen darüber habe, ob es eine Nichtübereinstimmung in ihrem Y-chromosomalen Genotyp gibt (ausschließlich väterlicherseits) vererbt,xi= 1 für Nichtübereinstimmung, 0 bei Übereinstimmung). Wenn es kein Missverhältnis gibt, haben sie zwar einen gemeinsamen väterlichen Vorfahren, aber wenn es einen gibt, muss es einen Knick in der Kette infolge einer oder mehrerer außerehelicher Angelegenheiten gegeben haben (ich kann jedoch nur feststellen, ob entweder keiner oder zumindest Ein solches Vaterschaftsereignis mit zusätzlichen Paaren ist aufgetreten, dh die abhängige Variable wird zensiert. Was mich interessiert, ist eine maximale Wahrscheinlichkeitsschätzung (plus 95% Konfidenzgrenzen) nicht nur für die mittlere EPP-Rate (Extra-Pair Vaterschaft) (Wahrscheinlichkeit, dass ein Kind pro Generation aus einer Kopulation mit zusätzlichen Paaren abgeleitet wird), sondern auch um auch zu schließen, wie sich die Vaterschaftsrate für zusätzliche Paare in Abhängigkeit von der Zeit geändert haben könnte (da die Anzahl der Generationen, die den gemeinsamen väterlichen Vorfahren trennten, einige Informationen dazu haben sollte - wenn es eine Nichtübereinstimmung gibt, die ich nicht habe) Ich weiß zwar nicht, wann die EVPs stattgefunden hätten, wie es irgendwo zwischen der Generation dieses mutmaßlichen Vorfahren und der Gegenwart gewesen sein könnte, aber wenn es eine Übereinstimmung gibt, sind wir sicher, dass es in keiner der vorhergehenden Generationen EPPs gab. Daher werden sowohl meine abhängige Binomialvariable als auch die unabhängige Erzeugung / Zeit der Kovariate zensiert. Basierend auf einem etwas ähnlichen Problem gepostetHier habe ich bereits herausgefunden, wie ich eine Maximum-Likelihood-Schätzung der Bevölkerung und der zeitlichen durchschnittlichen Vaterschaftsrate für zusätzliche Paare phatplus 95% -Profilwahrscheinlichkeits-Konfidenzintervalle in R wie folgt vornehmen kann :

# 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)
}

Beispiel mit einigen Pilotdaten (von 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

Maximum-Likelihood-Schätzung der Bevölkerung und zeitliche durchschnittliche Vaterschaftsrate für zusätzliche Paare plus 95% -Konfidenzgrenzen:

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

dh 0,9% [0,43-1,75% 95% CLs] aller Kinder stammten von einem Vater, der anders war als der vermeintliche.

Ich wollte dann noch einen Schritt weiter gehen und auch versuchen, einen möglichen zeitlichen Trend in der Vaterschaftsrate für zusätzliche Paare pals Funktion der Generierung abzuschätzen ni(der Einfachheit halber unter der Annahme einer linearen Beziehung zwischen den logarithmischen Chancen für die Beobachtung eines Vaterschaftsereignisses für zusätzliche Paare und Generation) unter Berücksichtigung der niTatsache, dass die EPP-Ereignisse bei Auftreten einer Nichtübereinstimmung irgendwo zwischen der Generation des gemeinsamen Vorfahren und der Gegenwart (Generation 0) stattgefunden haben könnten und dass, wenn keine Nichtübereinstimmung aufgetreten wäre, kein EPP-Ereignis hätte stattfinden können eine der vorherigen Generationen für dieses bestimmte Paar von Individuen.

Wenn wir vorher angenommen haben, dass die Wahrscheinlichkeit, dass ein Kind aus einer Extrapaar-Kopulation , konstant ist, und wenn eine Zufallsvariable gleich wenn eine Fehlpaarung der Y-Chromosomen beobachtet wird (entsprechend 1 oder mehr EPP-Ereignissen) und Andernfalls betrug die Wahrscheinlichkeit, keine Fehlpaarung (dh ) zu beobachten, wenn der väterliche Vorfahr vor Generationen lebte ( ), , während die Wahrscheinlichkeit von Beobachtung eines EVP-Ereignisses war $p$ $X$ $1$ $0$ $X=0$ $n$ $n = 1, 2, 3, \ldots$ $(1-p)^n$

Pr (X = 1 | n) = 1 - (1 - p)^{n} .

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

In einem Datensatz unabhängiger Beobachtungen von mit väterlichen Vorfahren, die vor Generationen lebten, war die Wahrscheinlichkeit daher $\mathbf{x} = (x_1, x_2, \ldots)$ $X$ $\mathbf{n} = (n_1, n_2, \ldots)$

L (p; x, n) = \prod_{x_{i} = 1} (1 - (1 - p)^{n_{i}}) \prod_{x_{j} = 0} (1 - p)^{n_{j}},

$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},$

was zu einer logarithmischen Wahrscheinlichkeit von

Λ (p) = \sum_{x_{i} = 1} \log (1 - (1 - p)^{n_{i}}) + \sum_{x_{j} = 0} n_{j} \log (1 - p) .

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

Unter Berücksichtigung der Tatsache, dass ich in meinem komplexeren Modell mit zeitlicher Dynamik möchte, dass jetzt eine Funktion von , mit , dh $p$ $n$

l o g (p / (1 - p)) = a + b . n

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

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

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

Ich habe dann die Definition der obigen Wahrscheinlichkeitsfunktion entsprechend geändert und sie mit der Funktion mle2aus dem Paket maximiert 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

Dies gibt mir eine vernünftig aussehende historische Schätzung der Entwicklung der EVP-Rate im Zeitverlauf: $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)")

Ich bin jedoch immer noch ein wenig festgefahren, wie die 95% -Konfidenzintervalle für die Gesamtvorhersage dieses Modells berechnet werden sollen. Würde jemand zufällig wissen, wie man das macht? Verwenden Sie möglicherweise Populationsvorhersageintervalle (durch erneutes Abtasten von Parametern gemäß der Anpassung nach einer multivariaten Normalverteilung) (oder würde die Delta-Methode auch funktionieren?)? Und könnte jemand kommentieren, ob meine obige Logik korrekt ist? Ich habe mich auch gefragt, ob diese Art von zensiertem Binomialmodell unter einem Standardnamen in der Literatur bekannt ist und ob jemand veröffentlichte Arbeiten zur Durchführung dieser Art von ML-Berechnungen unter dieser Art von Modell kennt. (Ich habe das Gefühl, dass das Problem ziemlich normal sein und etwas entsprechen sollte, das bereits getan wurde, aber anscheinend nichts findet ...)

[PS-Artikel mit mehr Hintergrundinformationen zu diesem Thema / Problem finden Sie hier und hier]

— Tom Wenseleers
quelle

Zuerst würde ich Ihre 'Confint'-Grenzen für Ihre Parameter betrachten. Sie können wiederholt zufällig Parameter innerhalb der Domäne von 5% bis 95% auswählen und "Anpassungspunkte" erstellen. Nachdem Sie dies einige Male getan haben, können Sie Fehlerbalken um Ihre zentrale Tendenz als Funktion von Generationen vor erhalten. Sie können sich ansehen, wie Bootstrap Ihre ursprünglichen Daten erneut abtastet und die Ausgabeschätzung erneut ausführt und verwendet, anstatt sie gleichmäßig zufällig abzutasten.

— EngrStudent

Ist das also mehr oder weniger das, was B. Bolker in dieser Populationsvorhersageintervallmethode vorschlägt? Dh wiederholt Parameter auswählen mit Bibliothek (MASS) params.picked = mvrnorm (5000, mu = coef (fit1), Sigma = vcov (fit1)), dann meine Vorhersagen mit diesen machen und die 95% Quantile berechnen? Ich glaube, ich verstehe es jetzt ...

— Tom Wenseleers

Basierend auf Ben Bolkers Kapitel und Kommentar oben habe ich am Ende herausgefunden, dass die 95% Populationsvorhersageintervalle durch gegeben sind

# 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)

— Tom Wenseleers
quelle

Was für eine interessante Figur. Nach 20 Generationen wird die Steigung der oberen 95% -Grenze positiv. Dies könnte auf ein periodisches Verhalten hindeuten, wenn es nicht um die durch die Grenzen verursachte Unsicherheit geht.

— EngrStudent

Nein, es liegt nur an der Unsicherheit in der Nähe der Grenzen, an denen ich Daten habe (die meisten Daten sind zwischen 7 und 20 Generationen konzentriert). Dies ist jedoch nur ein Pilotdatensatz - wir sollten bald einen Datensatz haben, der etwa 10x größer ist.

— Tom Wenseleers

Teilen Sie, wenn Sie fertig sind. Das ist interessant!

— EngrStudent