绘制预测概率（logit）

时间：2020-06-11 19:17:12

标签： r ggplot2 logistic-regression

我目前正在尝试在r中绘制我的logit模型的预测概率。我从以下链接中采用了该方法：https://stats.idre.ucla.edu/r/dae/logit-regression/。

鉴于利益集团的类型，我已经成功地为布鲁塞尔办事处绘制了地块。但是，我只想绘制各个影响：例如，我想绘制与MEP开会时布鲁塞尔办事处的预计概率（也就是说，当您有布鲁塞尔办事处时与MEP开会的概率是多少？）。另外，我想查看人员规模和/或组织形式对因变量的影响。

我还没有找到这种方法。有什么建议吗？

谢谢。

我的变量：

与MEPS的会议（因变量，虚拟） 1是 0否

兴趣组类型（分类） 1个业务 2顾问 3个非政府组织 4公共机构 5个机构 6工会/prof.org。 7其他

布鲁塞尔办事处 1是 0否

组织形式 1个个人组织。 2全国协会 3欧洲协会 4其他

工作人员人数（计数变量，以全时制显示） 范围从0.25到40

2 个答案:

答案 0 :(得分：0)

由于您未提供数据，因此将使用您从UCLA熟悉的示例中得到的数据集。您是否要尝试这样做（假设Rank就像您的变量之一... 

library(ggplot2)

mydata <- read.csv("binary.csv")
mydata$rank <- factor(mydata$rank)

mylogit <- glm(admit ~ gre + gpa + rank, data = mydata, family = "binomial")
summary(mylogit)
#> 
#> Call:
#> glm(formula = admit ~ gre + gpa + rank, family = "binomial", 
#>     data = mydata)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -1.6268  -0.8662  -0.6388   1.1490   2.0790  
#> 
#> Coefficients:
#>              Estimate Std. Error z value Pr(>|z|)    
#> (Intercept) -3.989979   1.139951  -3.500 0.000465 ***
#> gre          0.002264   0.001094   2.070 0.038465 *  
#> gpa          0.804038   0.331819   2.423 0.015388 *  
#> rank2       -0.675443   0.316490  -2.134 0.032829 *  
#> rank3       -1.340204   0.345306  -3.881 0.000104 ***
#> rank4       -1.551464   0.417832  -3.713 0.000205 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 499.98  on 399  degrees of freedom
#> Residual deviance: 458.52  on 394  degrees of freedom
#> AIC: 470.52
#> 
#> Number of Fisher Scoring iterations: 4

newdata1 <- with(mydata, data.frame(gre = mean(gre), gpa = mean(gpa), rank = factor(1:4)))

newdata1
#>     gre    gpa rank
#> 1 587.7 3.3899    1
#> 2 587.7 3.3899    2
#> 3 587.7 3.3899    3
#> 4 587.7 3.3899    4

newdata1$rankP <- predict(mylogit, newdata = newdata1, type = "response")
newdata1
#>     gre    gpa rank     rankP
#> 1 587.7 3.3899    1 0.5166016
#> 2 587.7 3.3899    2 0.3522846
#> 3 587.7 3.3899    3 0.2186120
#> 4 587.7 3.3899    4 0.1846684

ggplot(newdata1, aes(x = rank, y = rankP)) +
   geom_col()

答案 1 :(得分：0)

从昨天开始接送。

library(ggplot2)

# mydata <- read.csv("binary.csv")
str(mydata)
#> 'data.frame':    400 obs. of  4 variables:
#>  $ admit: int  0 1 1 1 0 1 1 0 1 0 ...
#>  $ gre  : int  380 660 800 640 520 760 560 400 540 700 ...
#>  $ gpa  : num  3.61 3.67 4 3.19 2.93 3 2.98 3.08 3.39 3.92 ...
#>  $ rank : int  3 3 1 4 4 2 1 2 3 2 ...

mydata$rank <- factor(mydata$rank)

mylogit <- glm(admit ~ gre + gpa + rank, data = mydata, family = "binomial")

summary(mylogit)
#> 
#> Call:
#> glm(formula = admit ~ gre + gpa + rank, family = "binomial", 
#>     data = mydata)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -1.6268  -0.8662  -0.6388   1.1490   2.0790  
#> 
#> Coefficients:
#>              Estimate Std. Error z value Pr(>|z|)    
#> (Intercept) -3.989979   1.139951  -3.500 0.000465 ***
#> gre          0.002264   0.001094   2.070 0.038465 *  
#> gpa          0.804038   0.331819   2.423 0.015388 *  
#> rank2       -0.675443   0.316490  -2.134 0.032829 *  
#> rank3       -1.340204   0.345306  -3.881 0.000104 ***
#> rank4       -1.551464   0.417832  -3.713 0.000205 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 499.98  on 399  degrees of freedom
#> Residual deviance: 458.52  on 394  degrees of freedom
#> AIC: 470.52
#> 
#> Number of Fisher Scoring iterations: 4

我们将在x轴上绘制GPA图表，让我们生成一些点

range(mydata$gpa) # using GPA for your staff size
#> [1] 2.26 4.00

gpa_sequence <- seq(from = 2.25, to = 4.01, by = .01) # 177 points along x axis

这是在IDRE示例中，但使它们变得复杂。第一步建立一个数据框架，其中包含我们的GPA点顺序，该列中每个条目的GRE平均值以及我们的4个因子重复177次。

constantGRE <- with(mydata, data.frame(gre = mean(gre), # keep GRE constant
                                       gpa = rep(gpa_sequence, each = 4), # once per factor level
                                       rank = factor(rep(1:4, times = 177)))) # there's 177

str(constantGRE)
#> 'data.frame':    708 obs. of  3 variables:
#>  $ gre : num  588 588 588 588 588 ...
#>  $ gpa : num  2.25 2.25 2.25 2.25 2.26 2.26 2.26 2.26 2.27 2.27 ...
#>  $ rank: Factor w/ 4 levels "1","2","3","4": 1 2 3 4 1 2 3 4 1 2 ...

对177个GPA值中的每一个* 4个因子水平进行预测。将该预测结果放到名为theprediction

的新列中 
constantGRE$theprediction <- predict(object = mylogit, 
                                      newdata = constantGRE, 
                                      type = "response")

在等级级别上绘制一行，对行进行唯一着色。 NB 直线不是直线，也不是完全平行，也不是等距分布。

ggplot(constantGRE, aes(x = gpa, y = theprediction, color = rank)) +
  geom_smooth()
#> `geom_smooth()` using method = 'loess' and formula 'y ~ x'

您可能会想只average行。 不要。如果您想了解GRE不包含等级的GPA，则因为(0.6357521 + 0.4704174 + 0.3136242 + 0.2700262) / 4是不正确的答案，请建立一个新模型。

开始吧。

# leave rank out call it new name

mylogit2 <- glm(admit ~ gre + gpa, data = mydata, family = "binomial")
summary(mylogit2)
#> 
#> Call:
#> glm(formula = admit ~ gre + gpa, family = "binomial", data = mydata)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -1.2730  -0.8988  -0.7206   1.3013   2.0620  
#> 
#> Coefficients:
#>              Estimate Std. Error z value Pr(>|z|)    
#> (Intercept) -4.949378   1.075093  -4.604 4.15e-06 ***
#> gre          0.002691   0.001057   2.544   0.0109 *  
#> gpa          0.754687   0.319586   2.361   0.0182 *  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 499.98  on 399  degrees of freedom
#> Residual deviance: 480.34  on 397  degrees of freedom
#> AIC: 486.34
#> 
#> Number of Fisher Scoring iterations: 4

重复其余过程以获取一行

constantGRE2 <- with(mydata, data.frame(gre = mean(gre),
                                       gpa = gpa_sequence))
constantGRE2$theprediction <- predict(object = mylogit2, 
                                      newdata = constantGRE2, 
                                      type = "response")
ggplot(constantGRE2, aes(x = gpa, y = theprediction)) +
  geom_smooth()
#> `geom_smooth()` using method = 'loess' and formula 'y ~ x'

相关问题
最新问题