Как построить 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')

Это должно дать вам такой вывод:

Надеюсь, это поможет!