Intervalos de confiança de 95% na previsão do modelo binomial censurado estimado usando mle2 / probabilidade máxima

Estou trabalhando em um problema no qual tenho vários pares de homens atualmente vivos, icada um com um suposto ancestral paterno nigerações atrás (com base em evidências genealógicas) e onde tenho informações sobre se há uma incompatibilidade no genótipo cromossômico Y (exclusivamente paternalmente herdadoxi= 1 para incompatibilidade, 0 se houver uma correspondência). Se não há incompatibilidade, eles realmente têm um ancestral paterno comum, mas se existe, deve ter havido uma torção na cadeia como resultado de um ou mais casos extraconjugais (só posso detectar se nenhum ou pelo menos um desses eventos de paternidade extra-par aconteceu, ou seja, a variável dependente é censurada). O que me interessa é obter uma estimativa de máxima verossimilhança (mais limites de confiança de 95%) não apenas da taxa média de paternidade de par extra (EPP) (probabilidade de que por geração uma criança derivaria de uma cópula de par extra), mas também para tentar inferir como a taxa de paternidade dos pares extras pode ter mudado em função do tempo (como o número de gerações que separaram o ancestral paterno comum deve ter algumas informações sobre isso - quando há uma incompatibilidade, não Não sei, porém, quando os EPPs teriam acontecido, como poderia estar em qualquer lugar entre a geração desse ancestral presumido e o presente, mas quando houver uma correspondência, temos certeza de que não houve EPPs em nenhuma das gerações anteriores). Portanto, tanto a minha variável binomial dependente quanto a geração / tempo covariável independente são censuradas. Com base em um problema semelhante, publicadoaqui, eu já descobri como poderia fazer uma estimativa de probabilidade máxima da população e a taxa de paternidade extra-média de tempo médio mais os phatintervalos de confiança de probabilidade de perfil de 95% em R da seguinte maneira:

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

Exemplo com alguns dados piloto (de 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

Estimativa de máxima verossimilhança da população e taxa de paternidade extra-média de tempo médio mais limites de confiança de 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

isto é, 0,9% [0,43-1,75% 95% CLs] de todas as crianças foram derivadas de um pai diferente do suposto.

Eu queria dar um passo adiante e também tentar estimar uma possível tendência temporal na taxa de paternidade dos pares extras em pfunção da geração ni(por simplicidade, assumindo uma relação linear entre as chances de log de observar um evento de paternidade dos pares extras e geração), levando em consideração que, se ocorrer uma incompatibilidade, os eventos EPP poderiam ter ocorrido em qualquer lugar entre a geração do ancestral comum nie o presente (geração 0), e que, se não houvesse incompatibilidade, nenhum evento EPP poderia ter ocorrido em algum momento. qualquer das gerações anteriores para esse par específico de indivíduos.

Se antes que assumiu a probabilidade de uma criança a ser derivado a partir de um extra-par cópula para ser constante, e se foi uma variável aleatória ser igual a quando foi observado um cromossoma incompatibilidade Y (que corresponde a um ou mais eventos de EPP) e caso contrário, a probabilidade de não haver incompatibilidade (isto é, ) quando o ancestral paterno viveu gerações atrás ( ) era , enquanto a chance de observar um evento EPP foi $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.$

Em um conjunto de dados de observações independentes de com ancestrais paternos vivendo gerações atrás, a probabilidade era $\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},$

resultando em uma probabilidade logarítmica de

Λ (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).$

Considerando que no meu modelo mais complexo que incorpora a dinâmica temporal, quero que seja uma função de agora, com , ou seja, $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))$

Alterei a definição da função de probabilidade acima e a maximizei usando a função mle2do pacote 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

Isso me dá uma estimativa histórica razoável da evolução da taxa de PPE longo do tempo: $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)")

No entanto, ainda estou um pouco preocupado em como calcular os intervalos de confiança de 95% na previsão geral desse modelo. Alguém saberia fazer isso por acaso? Talvez usando intervalos de previsão da população (por reamostragem de parâmetros de acordo com o ajuste após uma distribuição normal multivariada) (ou o método delta também funcionaria?)? E alguém poderia comentar se minha lógica acima está correta? Também estava me perguntando se esse tipo de modelo binomial censurado é conhecido sob algum nome padrão na literatura e se alguém conhece algum trabalho publicado sobre esse tipo de cálculo de ML nesse tipo de modelo? (Tenho a sensação de que o problema deve ser razoavelmente padrão e corresponder a algo que já foi feito, mas parece que não consigo encontrar nada ...)

[Documentos do PS com mais informações sobre esse tópico / problema estão disponíveis aqui e aqui]

— Tom Wenseleers
fonte

Primeiro, eu examinaria seus limites de 'confint' para seus parâmetros. Você pode escolher aleatoriamente parâmetros aleatoriamente dentro do domínio de 5% a 95% e criar "pontos de ajuste". Depois de fazer isso várias vezes, você pode obter barras de erro em torno de sua tendência central em função de gerações atrás. Você pode observar o bootstrap reamostrando seus dados iniciais e reexecutando e usando a estimativa de saída em vez de amostragem aleatória uniforme.

— EngrStudent

Então, isso é mais ou menos o que B. Bolker sugere neste método de intervalo de previsão da população? Ou seja, escolha repetidamente parâmetros usando a biblioteca (MASS) params.picked = mvrnorm (5000, mu = coef (ajuste1), Sigma = vcov (ajuste1)), fazendo minhas previsões com eles e calculando os quantis de 95%? Acho que entendo agora ...

— Tom Wenseleers

Com base no capítulo de Ben Bolker e no comentário acima, concluí que os intervalos de previsão de 95% da população são dados por

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

Que figura interessante. Após 20 gerações, a inclinação do limite superior de 95% torna-se positiva. Isso poderia sugerir um comportamento periódico se não se tratasse de incerteza introduzida pelos limites.

— EngrStudent

Não, é apenas por causa da incerteza perto dos limites de onde tenho dados (a maioria dos dados está concentrada entre 7 e 20 gerações). Mas este é apenas um conjunto de dados piloto - em breve devemos ter um conjunto de dados cerca de 10x maior.

— Tom Wenseleers

Compartilhe quando terminar. Isto é interessante!

— EngrStudent