Чи можна тлумачити включення квадратичного терміна в логістичну регресію як вказівку на перелом?

У логістичної регресії з лінійними і квадратичними членами тільки, якщо у мене є лінійний коефіцієнт і квадратичний коефіцієнт , я можу сказати, що є точка повороту ймовірності на ?$\beta_1$$\beta_2$$-\beta_1 / (2\beta_2)$

Так, ти можеш.

Модель є

Коли $\beta_2$ є нульовим, це має глобальний екстремум при $x = -\beta_1 / (2\beta_2)$ .

Логістична регресія оцінює ці коефіцієнти як . Оскільки це максимальна оцінка правдоподібності (а оцінки ML функцій параметрів є однаковими функціями оцінок), ми можемо оцінити розташування екстремуму на рівні .$(b_0, b_1, b_2)$$-b_1/(2b_2)$

Інтервал довіри для цієї оцінки буде цікавим. Для наборів даних, які є достатньо великими для застосування теорії максимальної асимптотики, ми можемо знайти кінцеві точки цього інтервалу шляхом повторного вираження у формі$\beta_0 + \beta_1 x + \beta_2 x^2$

і знаходження кількості можна змінити до того, як вірогідність журналу занадто зменшиться. "Занадто багато" - це асимптотично половина розподілу чи-квадрата з однією ступенем свободи.$\gamma$$1-\alpha/2$

Цей підхід буде добре працювати за умови, що діапазони охоплюють обидві сторони піку і серед значень є достатня кількість відповідей та щоб визначити цей пік. В іншому випадку розташування піку буде дуже невизначеним, а асимптотичні оцінки можуть бути недостовірними.$x$$0$$1$$y$

Rкод для його виконання наведено нижче. Він може бути використаний в моделюванні для перевірки того, що покриття довірчих інтервалів близьке до запланованого покриття. Зауважте, як справжній пік дорівнює і - дивлячись на нижній рядок гістограм - як більшість нижніх довірчих меж менші за справжнє значення та більшість верхніх довірчих меж перевищують справжнє значення, як ми сподіваємось У цьому прикладі передбачуване покриття становило а фактичне покриття (дисконтування чотирьох із випадків, коли логістична регресія не збігалася) становило , що свідчить про те, що метод працює добре (для видів модельованих даних тут).$-1/2$$1 - 2(0.05) = 0.90$$500$$0.91$

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