r - 如何在ggplot中突出显示沿曲线的点

Question

我有下面的代码来绘制一个概率模型，比较基于最高温度值的成功机会。感觉效果不错，剧情很满意。但我希望突出显示概率为 50% 的曲线上的点，然后向下画一条线到 x 轴以确定(并显示)该值。还希望包括此估计的置信区间。任何帮助将不胜感激!

data <- data.frame(MaxTemp = c(53.2402, 59.01004,51.42602,41.53883,44.70763,53.90285,51.130318,54.5929,43.697559,49.772446,54.902222,52.720528,58.782608,47.680374,48.30313,56.10921,57.660324,46.387924,60.503147,53.803177,52.27771,58.58555,55.74136,49.04505,46.816269,52.58295,52.751373,56.209747,51.733894,51.424305,50.74564,47.046513,53.030407,56.68752,56.639351,53.526585,51.562313), 
                   Success=c(1,1,1,0,0,1,1,1,0,0,1,1,1,0,0,1,1,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0,1,1,1,1,1))
TempProbitModel <- glm(Success ~ MaxTemp, data=data, family=binomial(link="logit"))                   
temp.data <- data.frame(MaxTemp = seq(40, 62, 0.5))
predicted.data <- as.data.frame(predict(TempProbitModel, newdata = temp.data, type="link", se=TRUE))
new.data <- cbind(temp.data, predicted.data)
std <- qnorm(0.95 / 2 + 0.5)
new.data$ymin <- TempProbitModel$family$linkinv(new.data$fit - std * new.data$se)
new.data$ymax <- TempProbitModel$family$linkinv(new.data$fit + std * new.data$se)
new.data$fit <- TempProbitModel$family$linkinv(new.data$fit)
(TempProb <- ggplot(data, aes(x=MaxTemp, y=Success)) + 
  geom_point() +  
  geom_ribbon(data=new.data, aes(y=fit, ymin=ymin, ymax=ymax), alpha=0.5) +  
  geom_line(data=new.data, aes(y=fit)) +
  labs(x="Peak Temperature", y="Probability of Success") )

Answer 1

找到最接近 y = 0.5 的值:

closest_value <- which(abs(new.data$fit - 0.5) == min(abs(new.data$fit - 0.5)))

计算此时的斜率:

slope_at_closest_value <- (new.data[closest_value, "MaxTemp"] - new.data[closest_value - 1, "MaxTemp"]) /( new.data[closest_value, "fit"] - new.data[closest_value - 1, "fit"])
x_value <- new.data[closest_value - 1, "MaxTemp"] + slope_at_closest_value * (0.5 - new.data[closest_value - 1, "fit"])

使用这个 x_value 画一条垂直线:

ggplot(data, aes(x=MaxTemp, y=Success)) +
  geom_point() +
  geom_ribbon(data=new.data, aes(y=fit, ymin=ymin, ymax=ymax), alpha=0.5) +
  geom_line(data=new.data, aes(y=fit)) +
  labs(x="Peak Temperature", y="Probability of Success") +
  geom_vline(xintercept = x_value, color="red")

绘制如下图:

可以据此得出置信区间。