如何为我的逻辑回归模型绘制S曲线？

Question

我正在尝试将S曲线拟合到我的逻辑回归模型中，但是我所拥有的只是这条稍微弯曲的线，而不是S形的线。我应该在代码中更改一些内容吗？

#Log Regression model
logmodel<-glm(y~emp.var.rate,data=Dataset,family=binomial)
summary(logmodel)

#plot
plot(emp.var.rate,y)
x<-seq(from=min(emp.var.rate),to=max(emp.var.rate))
hat.beta<-coef(logmodel)
hat.beta
lines(x, (1 + exp(-hat.beta[1] - hat.beta[2]*x))^(-1), col="blue")

> hat.beta
 (Intercept) emp.var.rate 
  -2.2207829   -0.5203776

Answer 1

我有几年前使用的出色功能。它打印出S形的预测线性化的模型，并在模型中按颜色和按重量分配元素来绘制模型不匹配：

library(dplyr); library(ggplot2);

#create your model
m1 <- glm(C(prog25) ~ C(sex) + ageB + gfrB +  mapB + C(M) + C(E) + C(S) + C(T) + C(CRESC) + C(cat0) + tlr4l , data=df10, family=binomial(link=logit))

#extract data for plot
df10$predicted <- predict(m1, type="response")
df10$residuals <- residuals(m1, type = "response")
df10$linearized <- m1$linear.predictors
df10$weights <- m1$weights

#reinterpret as numeric
df10$prog25 <- as.numeric(df10$prog25)

#assign id to know the model "mismatched"
df10$id <- seq(1,nrow(df10))
mism <- df10 %>% filter(prog25 != round(predicted))
for (i in 1:nrow(df10)) {
            if (!is.na(match(df10$id[i],mism$id))) m <- 1
            else m <- 0
            df10$mismatched[i] <- m
            }
#then remove ID
df10$id <- NULL

#define a function to plot the model
gra.tot <- function(dat, varLin, varY, varP, group, fitModel, devModel, dfModel, devNull, dfNull, aicModel, nameX, nameY) {
  ggplot(dat, aes(x = varLin, y = varY)) +
  geom_point(aes(size=varP, color=as.factor(group)), alpha=.3) +
  scale_colour_manual(name="mismatched", values = c("grey30", "red3")) +
  geom_text(x= min(varLin) + (0.1 * (max(varLin) - min(varLin))) , y=0.5,          hjust=0, label=paste( 'predicted ~ linearized', "\nmismatched: ",sum(group),"/",length(fitModel), '\nres. deviance: ', round(devModel,2) , ' (df: ', round(dfModel,2),')',  '\nnull deviance: ', round(devNull,2), ' (df: ', round(dfNull,2),')', '\nAIC: ', round(aicModel,2) ), col='grey40', size=3, fontface='italic') +
  xlab(as.character(nameX)) +
  ylab(as.character(nameY)) +
  theme_bw()
}

#plot the model
tot <- gra.tot(df10, df10$linearized, df10$predicted, df10$weights, df10$mismatched, m1$fitted, m1$deviance, m1$df.residual, m1$null.deviance, m1$df.null, m1$aic, 'linearized_predictors', 'logit_risk')

应该会给您这样的输出：

希望有帮助！