Calcule la probabilidad logarítmica "a mano" para la regresión generalizada de mínimos cuadrados no lineales (nlme)

Estoy tratando de calcular la probabilidad logarítmica de una regresión no lineal generalizada de mínimos cuadrados para la función optimizada por funcionan en el paquete R , usando la matriz de covarianza de varianza generada por distancias en un árbol filogenético asumiendo movimiento browniano ( del paquete). El siguiente código R reproducible se ajusta al modelo gnls utilizando datos x, y y un árbol aleatorio con 9 taxones:$f(x)=\frac{\beta_1}{(1+\frac x\beta_2)^{\beta_3}}$gnlsnlmecorBrownian(phy=tree)ape

require(ape)
require(nlme)
require(expm)
tree <- rtree(9)
x <- c(0,14.51,32.9,44.41,86.18,136.28,178.21,262.3,521.94)
y <- c(100,93.69,82.09,62.24,32.71,48.4,35.98,15.73,9.71)
data <- data.frame(x,y,row.names=tree$tip.label)
model <- y~beta1/((1+(x/beta2))^beta3)
f=function(beta,x) beta[1]/((1+(x/beta[2]))^beta[3])
start <- c(beta1=103.651004,beta2=119.55067,beta3=1.370105)
correlation <- corBrownian(phy=tree)
fit <- gnls(model=model,data=data,start=start,correlation=correlation)
logLik(fit) 

Me gustaría calcular la probabilidad de registro "a mano" (en R, pero sin el uso de la logLikfunción) en función de los parámetros estimados obtenidos de gnlsmodo que coincida con la salida de logLik(fit). NOTA: No estoy tratando de estimar parámetros; Solo quiero calcular la probabilidad logarítmica de los parámetros estimados por la gnlsfunción (aunque si alguien tiene un ejemplo reproducible de cómo estimar parámetros sin él gnls, ¡estaría muy interesado en verlo!).

No estoy realmente seguro de cómo hacer esto en R. La notación de álgebra lineal descrita en los Modelos de efectos mixtos en S y S-Plus (Pinheiro y Bates) está muy por encima de mi cabeza y ninguno de mis intentos ha coincidido logLik(fit). Aquí están los detalles descritos por Pinheiro y Bates:

La probabilidad logarítmica para el modelo de mínimos cuadrados no lineales generalizados donde se calcula de la siguiente manera:$y_i=f_i(\phi_i,v_i)+\epsilon_i$$\phi_i=A_i\beta$

$l(\beta,\sigma^2,\delta|y)=-\frac 12 \Bigl\{ N\log(2\pi\sigma^2)+\sum\limits_{i=1}^M{\Bigl[\frac{||y_i^*-f_i^*(\beta)||^2}{\sigma^2}+\log|\Lambda_i|\Bigl]\Bigl\}}$

donde$N$ es el número de observaciones, y .$f_i^*(\beta)=f_i^*(\phi_i,v_i)$

es positivo-definido, y ∗ i = Λ - T / 2 i y i y f ∗ i ( ϕ i , v i ) = Λ - T / 2 i f i ( ϕ i , v i$\Lambda_i$$y_i^*=\Lambda_i^{-T/2}y_i$$f_i^*(\phi_i,v_i)=\Lambda_i^{-T/2}f_i(\phi_i,v_i)$

Para y λ fijos , el estimador ML de σ 2 es$\beta$$\lambda$$\sigma^2$

$\hat\sigma(\beta,\lambda)=\sum\limits_{i=1}^M||y_i^*-f_i^*(\beta)||^2 / N$

y la probabilidad de registro perfilada es

$l(\beta,\lambda|y)=-\frac12\Bigl\{N[\log(2\pi/N)+1]+\log\Bigl(\sum\limits_{i=1}^M||y_i^*-f_i^*(\beta)||^2\Bigl)+\sum\limits_{i=1}^M\log|\Lambda_i|\Bigl\}$

$\beta$$\lambda$$\sigma^2$

$\sigma^2=\sum\limits_{i=1}^M\Bigl|\Bigl|\hat\Lambda_i^{-T/2}[y_i-f_i(\hat\beta)]\Bigl|\Bigl|^2/(N-p)$

$p$$\beta$

He compilado una lista de preguntas específicas que estoy enfrentando:

1. $\Lambda_i$big_lambda <- vcv.phylo(tree)ape$\lambda$
2. $\sigma^2$fit$sigma^2
3. $\lambda$$\lambda$$\Lambda_i$
4. $||y-f(\beta)||$norm(y-f(fit$coefficients,x),"F")Matrix$\sum\limits_{i=1}^M||y_i^*-f_i^*(\beta)||^2$norm()
5. $\log|\Lambda_i|$log(diag(abs(big_lambda)))big_lambda$\Lambda_i$logm(abs(big_lambda))expmlogm()
6. $\Lambda_i^{-T/2}$t(solve(sqrtm(big_lambda)))
7. $y_i^*$$f_i^*(\beta)$

y_star <- t(solve(sqrtm(big_lambda))) %*% y

y

f_star <- t(solve(sqrtm(big_lambda))) %*% f(fit$coefficients,x)

o sería

y_star <- t(solve(sqrtm(big_lambda))) * y

y

f_star <- t(solve(sqrtm(big_lambda))) * f(fit$coefficients,x) ?

Si todas estas preguntas son respondidas, en teoría, creo que la probabilidad de registro debería ser calculable para que coincida con la salida de logLik(fit). Cualquier ayuda en cualquiera de estas preguntas sería muy apreciada. Si algo necesita aclaración, hágamelo saber. ¡Gracias!

ACTUALIZACIÓN : He estado experimentando con varias posibilidades para el cálculo de la probabilidad de registro, y aquí está lo mejor que he encontrado hasta ahora. logLik_calces consistentemente aproximadamente 1 a 3 fuera desde el valor devuelto por logLik(fit). O estoy cerca de la solución real, o esto es puramente por coincidencia. ¿Alguna idea?

  C <- vcv.phylo(tree) # variance-covariance matrix
  tC <- t(solve(sqrtm(C))) # C^(-T/2)
  log_C <- log(diag(abs(C))) # log|C|
  N <- length(y)
  y_star <- tC%*%y 
  f_star <- tC%*%f(fit$coefficients,x)
  dif <- y_star-f_star  
  sigma_squared <-  sum(abs(y_star-f_star)^2)/N
  # using fit$sigma^2 also produces a slightly different answer than logLik(fit)
  logLik_calc <- -((N*log(2*pi*(sigma_squared)))+
       sum(((abs(dif)^2)/(sigma_squared))+log_C))/2

Comencemos con el caso más simple donde no hay una estructura de correlación para los residuos:

fit <- gnls(model=model,data=data,start=start)
logLik(fit)

La probabilidad de registro se puede calcular fácilmente a mano con:

N <- fit$dims$N
p <- fit$dims$p
sigma <- fit$sigma * sqrt((N-p)/N)
sum(dnorm(y, mean=fitted(fit), sd=sigma, log=TRUE))

Como los residuos son independientes, solo podemos usar dnorm(..., log=TRUE)para obtener los términos de probabilidad de registro individual (y luego resumirlos). Alternativamente, podríamos usar:

sum(dnorm(resid(fit), mean=0, sd=sigma, log=TRUE))

fit$sigma$\sigma^2$

Ahora para el caso más complicado donde los residuos están correlacionados:

fit <- gnls(model=model,data=data,start=start,correlation=correlation)
logLik(fit)

Aquí, necesitamos usar la distribución normal multivariante. Estoy seguro de que hay una función para esto en alguna parte, pero hagamos esto a mano:

N <- fit$dims$N
p <- fit$dims$p
yhat <- cbind(fitted(fit))
R <- vcv(tree, cor=TRUE)
sigma <- fit$sigma * sqrt((N-p)/N)
S <- diag(sigma, nrow=nrow(R)) %*% R %*% diag(sigma, nrow=nrow(R))
-1/2 * log(det(S)) - 1/2 * t(y - yhat) %*% solve(S) %*% (y - yhat) - N/2 * log(2*pi)