En una regresión logística solo con términos lineales y cuadráticos, si tengo un coeficiente lineal y un coeficiente cuadrático , ¿puedo decir que hay un punto de inflexión de la probabilidad en ?β 2 - β 1 / ( 2 β 2 )
En una regresión logística solo con términos lineales y cuadráticos, si tengo un coeficiente lineal y un coeficiente cuadrático , ¿puedo decir que hay un punto de inflexión de la probabilidad en ?β 2 - β 1 / ( 2 β 2 )
Sí tu puedes.
El modelo es
Cuando no es cero, tiene un extremo global en .
La regresión logística estima estos coeficientes como . Debido a que esta es una estimación de máxima verosimilitud (y las estimaciones de ML de las funciones de los parámetros son las mismas funciones de las estimaciones), podemos estimar que la ubicación del extremo está en .
Un intervalo de confianza para esa estimación sería de interés. Para los conjuntos de datos que son lo suficientemente grandes como para que se aplique la teoría asintótica de máxima verosimilitud, podemos encontrar los puntos finales de este intervalo en el formulario
y encontrar cuánto se puede variar antes de que la probabilidad logarítmica disminuya demasiado. "Demasiado" es, asintóticamente, la mitad del cuantil de una distribución chi-cuadrado con un grado de libertad.
Este enfoque funcionará bien siempre que los rangos de cubran ambos lados del pico y haya un número suficiente de respuestas y entre los valores de para delinear ese pico. De lo contrario, la ubicación del pico será altamente incierta y las estimaciones asintóticas pueden no ser confiables.
R
El código para llevar esto a cabo está debajo. Se puede utilizar en una simulación para verificar que la cobertura de los intervalos de confianza esté cerca de la cobertura prevista. Observe cómo el pico verdadero es y, al mirar la fila inferior de histogramas, cómo la mayoría de los límites de confianza inferiores son menores que el valor verdadero y la mayoría de los límites de confianza superiores son mayores que el valor verdadero, como esperamos En este ejemplo, la cobertura prevista era y la cobertura real (descontando cuatro de cada casos donde la regresión logística no convergía) fue , lo que indica que el método está funcionando bien (para los tipos de datos simulados aquí).
n <- 50 # Number of observations in each trial
beta <- c(-1,2,2) # Coefficients
x <- seq(from=-3, to=3, length.out=n)
y0 <- cbind(rep(1,length(x)), x, x^2) %*% beta
# Conduct a simulation.
set.seed(17)
sim <- replicate(500, peak(x, rbinom(length(x), 1, logistic(y0)), alpha=0.05))
# Post-process the results to check the actual coverage.
tp <- -beta[2] / (2 * beta[3])
covers <- sim["lcl",] <= tp & tp <= sim["ucl",]
mean(covers, na.rm=TRUE) # Should be close to 1 - 2*alpha
# Plot the distributions of the results.
par(mfrow=c(2,2))
plot(x, logistic(y0), type="l", lwd=2, col="#4040d0", main="Simulated Data",ylim=c(0,1))
points(x, rbinom(length(x), 1, logistic(y0)), pch=19)
hist(sim["peak.x",], main="Estimates"); abline(v=tp, col="Red")
hist(sim["lcl",], main="Lower Confidence Limits"); abline(v=tp, col="Red")
hist(sim["ucl",], main="Upper Confidence Limits"); abline(v=tp, col="Red")
logistic <- function(x) 1 / (1 + exp(-x))
peak <- function(x, y, alpha=0.05) {
#
# Estimate the peak of a quadratic logistic fit of y to x
# and a 1-alpha confidence interval for that peak.
#
logL <- function(b) {
# Log likelihood.
p <- sapply(cbind(rep(1, length(x)), x, x*x) %*% b, logistic)
sum(log(p[y==1])) + sum(log(1-p[y==0]))
}
f <- function(gamma) {
# Deviance as a function of offset from the peak.
b0 <- c(b[1] - b[2]^2/(4*b[3]) + b[3]*gamma^2, -2*b[3]*gamma, b[3])
-2.0 * logL(b0)
}
# Estimation.
fit <- glm(y ~ x + I(x*x), family=binomial(link = "logit"))
if (!fit$converged) return(rep(NA,3))
b <- coef(fit)
tp <- -b[2] / (2 * b[3])
# Two-sided confidence interval:
# Search for where the deviance is at a threshold determined by alpha.
delta <- qchisq(1-alpha, df=1)
u <- sd(x)
while(fit$deviance - f(tp+u) + delta > 0) u <- 2*u # Find an upper bound
l <- sd(x)
while(fit$deviance - f(tp-l) + delta > 0) l <- 2*l # Find a lower bound
upper <- uniroot(function(gamma) fit$deviance - f(gamma) + delta,
interval=c(tp, tp+u))
lower <- uniroot(function(gamma) fit$deviance - f(gamma) + delta,
interval=c(tp-l, tp))
# Return a vector of the estimate, lower limit, and upper limit.
c(peak=tp, lcl=lower$root, ucl=upper$root)
}