Практический пример логистической регрессии, когда мы имеем дело со сводными данными вместо двоичных (0,1)
Мы предоставим пример того, как вы можете запустить логистическую регрессию в R, когда данные сгруппированы. Приведем случайную выборку данных из 200 наблюдений.
library(tidyverse)
set.seed(5)
df<-tibble(Gender = as.factor(sample(c("m","f"), 200, replace = TRUE, prob=c(0.6,0.4))),
Age_Group = as.factor(sample(c("[<30]","[30-65]", "[65+]"), 200, replace = TRUE, prob=c(0.3,0.6,0.1))),
Response = rbinom(200, 1, prob = 0.2))
df
Вывод:
# A tibble: 200 x 3 Gender Age_Group Response <fct> <fct> <int> 1 f [65+] 0 2 m [30-65] 0 3 m [65+] 0 4 m [30-65] 0 5 m [<30] 0 6 m [<30] 0 7 m [30-65] 0 8 m [30-65] 0 9 f [<30] 1 10 f [<30] 0 # ... with 190 more rows
Логистическая регрессия на неагрегированных данных
Модель логистической регрессии выглядит следующим образом:
model1<-glm(Response ~ Gender+Age_Group, data = df, family = binomial("logit"))
summary(model1)
Вывод:
Call:
glm(formula = Response ~ Gender + Age_Group, family = binomial("logit"),
data = df)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.7039 -0.6246 -0.6094 -0.5677 1.9754
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.32296 0.40899 -3.235 0.00122 **
Genderm 0.05402 0.38041 0.142 0.88707
Age_Group[30-65] -0.26642 0.42010 -0.634 0.52596
Age_Group[65+] -0.47482 0.59460 -0.799 0.42455
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 188.56 on 199 degrees of freedom
Residual deviance: 187.83 on 196 degrees of freedom
AIC: 195.83
Number of Fisher Scoring iterations: 4
Логистическая регрессия агрегированных данных
Теперь предположим, что вы получили данные в агрегированной форме и вас попросили запустить логистическую регрессию. Во-первых, нам нужно сгенерировать агрегированные данные.
df_agg<-df%>%group_by(Gender, Age_Group)%>%summarise(Impressions=n(), Responses=sum(Response))%>% ungroup()%>%mutate(RR=Responses/Impressions) df_agg
Вывод:
# A tibble: 6 x 5 Gender Age_Group Impressions Responses RR <fct> <fct> <int> <int> <dbl> 1 f [<30] 21 6 0.286 2 f [30-65] 49 7 0.143 3 f [65+] 9 1 0.111 4 m [<30] 30 5 0.167 5 m [30-65] 66 13 0.197 6 m [65+] 25 4 0.16
Ниже мы представим три разных решения.
Логистическая регрессия с весами
m2<-glm(RR ~ Gender+Age_Group, data=df_agg, weights = Impressions, family = binomial("logit"))
summary(m2)
Вывод:
Call:
glm(formula = RR ~ Gender + Age_Group, family = binomial("logit"),
data = df_agg, weights = Impressions)
Deviance Residuals:
1 2 3 4 5 6
0.8160 -0.5077 -0.2754 -0.7213 0.4145 0.1553
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.32296 0.40899 -3.235 0.00122 **
Genderm 0.05402 0.38042 0.142 0.88707
Age_Group[30-65] -0.26642 0.42010 -0.634 0.52596
Age_Group[65+] -0.47482 0.59460 -0.799 0.42455
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 2.4477 on 5 degrees of freedom
Residual deviance: 1.7157 on 2 degrees of freedom
AIC: 29.167
Number of Fisher Scoring iterations: 4
Логистическая регрессия с cbind
Нам нужно будет создать еще один столбец с именем No Responses, а затем мы можем использовать cbind:
df_agg$No_Responses <- df_agg$Impressions- df_agg$Responses
m3<-glm(cbind(Responses, No_Responses) ~ Gender+Age_Group, data=df_agg, family = binomial("logit"))
summary(m3)
Вывод:
Call:
glm(formula = cbind(Responses, No_Responses) ~ Gender + Age_Group,
family = binomial("logit"), data = df_agg)
Deviance Residuals:
1 2 3 4 5 6
0.8160 -0.5077 -0.2754 -0.7213 0.4145 0.1553
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.32296 0.40899 -3.235 0.00122 **
Genderm 0.05402 0.38042 0.142 0.88707
Age_Group[30-65] -0.26642 0.42010 -0.634 0.52596
Age_Group[65+] -0.47482 0.59460 -0.799 0.42455
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 2.4477 on 5 degrees of freedom
Residual deviance: 1.7157 on 2 degrees of freedom
AIC: 29.167
Number of Fisher Scoring iterations: 4
Разверните агрегированные данные
Наконец, другим подходом будет преобразование совокупных данных в двоичную форму 0 и 1. Давайте сделаем это:
df2 <- df_agg %>% mutate(New_Response = map2(Responses, Impressions,
~ c(rep(1, .x),
rep(0, .y - .x))))%>%unnest(cols = c(New_Response))
df2
Вывод:
# A tibble: 200 x 7 Gender Age_Group Impressions Responses RR No_Responses New_Response <fct> <fct> <int> <int> <dbl> <int> <dbl> 1 f [<30] 21 6 0.286 15 1 2 f [<30] 21 6 0.286 15 1 3 f [<30] 21 6 0.286 15 1 4 f [<30] 21 6 0.286 15 1 5 f [<30] 21 6 0.286 15 1 6 f [<30] 21 6 0.286 15 1 7 f [<30] 21 6 0.286 15 0 8 f [<30] 21 6 0.286 15 0 9 f [<30] 21 6 0.286 15 0 10 f [<30] 21 6 0.286 15 0 # ... with 190 more rows
И теперь мы можем работать так же, как вначале.
model4<-glm(New_Response ~ Gender+Age_Group, data = df2, family = binomial("logit"))
summary(model4)
Вывод:
Call:
glm(formula = New_Response ~ Gender + Age_Group, family = binomial("logit"),
data = df2)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.7039 -0.6246 -0.6094 -0.5677 1.9754
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.32296 0.40899 -3.235 0.00122 **
Genderm 0.05402 0.38041 0.142 0.88707
Age_Group[30-65] -0.26642 0.42010 -0.634 0.52596
Age_Group[65+] -0.47482 0.59460 -0.799 0.42455
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 188.56 on 199 degrees of freedom
Residual deviance: 187.83 on 196 degrees of freedom
AIC: 195.83
Number of Fisher Scoring iterations: 4
Вывод
Для всех 4 моделей мы пришли к одинаковым коэффициентам и p-значениям. Однако в агрегированной форме мы получаем разные выходные данные относительно отклонения и оценки AIC по сравнению с двоичной формой.
Первоначально опубликовано на https://predictivehacks.com.
