我正在使用 purrr 在分組資料集的多列中運行一系列單線性回歸，但在排除沒有資料的變陣列而不洗掉整個組時遇到了麻煩。
感謝這里的andrew_reece ，我得到了基本代碼：
library(tidyverse)
ivs <- colnames(mtcars)[3:ncol(mtcars)]
names(ivs) <- ivs
mtcars %>%
group_by(cyl) %>%
group_modify(function(data, key) {
map_df(ivs, function(iv) {
frml <- as.formula(paste("mpg", "~", iv))
lm(frml, data = data) %>% broom::glance()
}, .id = "iv")
}) %>%
select(cyl, iv, r.squared, p.value)
它以這種格式給出了一個小標題：
cyl iv r.squared p.value
4 disp 0.6484051396 0.002782827
4 hp 0.2740558319 0.098398581
4 drat 0.180 0.193
4 wt 0.509 0.0137
4 qsec 0.0557 0.485
4 vs 0.00238 0.887
...
6 disp 0.0106260401 0.825929685
...
不幸的是，我的真實資料集很混亂，包含多個組變陣列合，只有 NA，或者少于兩個真實值，而 lm 無法處理。為了說明這一點，這里是 mtcars，其中 'disp' 中的一些資料被 NA 替換。運行上面的代碼，mtna 拋出 NA 錯誤。
#create mtcars dataset that will have a cyl group with entirely NA disp
mtna <- mtcars
mtna$disp[mtna$disp < 147] <- NA
test <- mtna %>% group_by(cyl) %>% summarize(mean = mean(disp))
我試圖通過使 lm 成為條件來解決這個問題，并首先使用 sum(!is.na) 檢查是否有足夠的真實值來運行 lm。這允許 lm 成功運行。
mtna %>%
group_by(cyl) %>%
group_modify(function(data, key) {
map_df(ivs, function(iv) {
tmpvar <- eval(parse(text = paste0("data$", iv)))
if(sum(!is.na(tmpvar)) < 3) {return(NA)} else {
frml <- as.formula(paste("mpg", "~", iv))
lm(frml, data = data) %>% broom::glance()
}}, .id = "iv")
}) %>%
select(cyl, iv, r.squared, p.value)
#which gives:
cyl iv r.squared p.value
1 4 NA NA NA
2 6 disp 0.0115 0.840
3 6 hp 0.0161 0.786
4 6 drat 0.0132 0.807
...
但是，當您查看結果時，您可以看到 NA 已擴展到整個組，包括除 disp 之外的變數（這是唯一具有缺失值的變數）。現在根本沒有相關的資料cyl = 4，即使在 hp 和 drat 等沒有丟失資料的組中也是如此。
我希望的是這樣的：
cyl iv r.squared p.value
4 disp NA NA
4 hp 0.2740558319 0.098398581 # Currently missing
4 drat 0.1799791311 0.193450651 # Currently missing
4 wt 0.5086325963 0.013742782. # Currently missing
...
6 disp 0.0106260401 0.825929685
6 hp 0.0161462379 0.78602021
...
我懷疑這與資料格式有關 - 我想我正在將 NA 映射到該組的所有結果中，而不僅僅是那個變數。但我不知道如何解決這個問題。任何幫助是極大的贊賞！
uj5u.com熱心網友回復：
我想你快到了。看看下面的代碼。更改已注釋。
library(tidyverse)
ivs <- colnames(mtcars)[3:ncol(mtcars)]
names(ivs) <- ivs
mtna <- mtcars
mtna$disp[mtna$disp < 147] <- NA
mtna %>%
group_by(cyl) %>%
group_modify(function(data, key) {
map_df(ivs, function(iv) {
tmpvar<-eval(parse(text = paste0("data$", iv)))
if(!is.na(sum(tmpvar))) { #only use complete data
frml <- as.formula(paste("mpg", "~", iv))
lm(frml, data = data) %>% broom::glance()
}}, .id = "iv")
}) %>%
select(cyl, iv, r.squared, p.value) %>%
right_join(.,expand.grid(cyl=unique(mtna$cyl),iv=ivs),
by=c("cyl","iv")) %>% #populating with NA for columns lost before
arrange(., cyl, iv) %>% #sort by cyl and iv
as.data.frame()
#which gives:
cyl iv r.squared p.value
1 4 am 0.2872892493 0.08921640
2 4 carb 0.0378466325 0.56650426
3 4 disp NA NA
4 4 drat 0.1799791311 0.19345065
5 4 gear 0.1146552225 0.30840242
6 4 hp 0.2740558319 0.09839858
7 4 qsec 0.0556742395 0.48487154
8 4 vs 0.0023819528 0.88668635
9 4 wt 0.5086325963 0.01374278
10 6 am 0.2810551424 0.22094408
11 6 carb 0.0000661434 0.98619369
12 6 disp NA NA
13 6 drat 0.0131597553 0.80653099
14 6 gear 0.0000901510 0.98388187
15 6 hp 0.0161462379 0.78602021
16 6 qsec 0.1753245893 0.34980138
17 6 vs 0.2810551424 0.22094408
18 6 wt 0.4645101506 0.09175766
19 8 am 0.0024647887 0.86615546
20 8 carb 0.1550637156 0.16359436
21 8 disp 0.2701577717 0.05677488
22 8 drat 0.0022975223 0.87074078
23 8 gear 0.0024647887 0.86615546
24 8 hp 0.0804491933 0.32575378
25 8 qsec 0.0108860059 0.72261712
26 8 vs 0.0000000000 NA
27 8 wt 0.4229655365 0.01179281
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/380665.html