R. 多元線性回歸在變量對上逐列迭代

Question

我有一個數據框 dfA（真實的有 1000 行和 400,000 列）。 從第 6 列開始，變量名稱是由 x 和不同前綴（GT_x、N_x、E_x）組成的“三元組”，其中 x = rs1、rs7、rs300、rs502 等：

ID    SEX    PV    GAN    GAE    GT_rs1    N_rs1    E_rs1    GT_rs7    N_rs7    E_rs7    ...
2    0    7.8    0.3    0.4    0    1    1    1    0    2    ...
6    1    6.4    0.35    0.55    0    0    1    1    1    2    ...

這是我的數據的可重現示例：

dfA = data.frame(rbind(c("ID","SEX","PV","GAN","GAE","GT_rs1","N_rs1","E_rs1","GT_rs7","N_rs7","E_rs7"), 
                   c(2,0,7.8,0.3,0.4,0,1,1,1,0,2),
                   c(6,1,6.4,0.35,0.55,0,0,1,1,1,2)))
dfA = dfA %>% row_to_names(row_number = 1)

使用 R，我想運行以下形式的線性回歸：

lm(PV ~ SEX + GAN + GT_x + N_x)

其中 x 是 rs1、rs7 等。 所以，我需要在成對的變量上逐列迭代。 我想獲得不同協變量（SEX、GAN、GT_x 和 N_x）的估計值、std.error、統計量和 p.value。 SEX = 分類變量； PV, GAN = 定量變量； GT_x、N_x、E_x = 附加變量。

Answer 1

這是一個在一個簡單的管道中帶有purrr的解決方案。

你只需要創建列表GT_x和N_x使用。 您可以通過使用一些正則表達式來做到這一點。

library(purrr)

nn <- names(df)
pattern <- "^GT_|^N_"

vars <- nn[grepl(pattern, nn)] # get the variables that start with GT_ and N_
x <- sub(pattern, "", vars)    # get every x

split(vars, x) %>%
 map(paste, collapse = " + ") %>% 
 sprintf("PV ~ SEX + GAN + %s", .) %>% 
 map(lm, data = df) %>% 
 map_dfr(broom::tidy, .id = "model")

這將返回一個唯一的數據幀。 每個模型由列model標識。 如果您更喜歡列表，只需將map_dfr替換為map並刪除.id 。

---

在這里，我創建了一個可重現的數據示例：

set.seed(1)
df <- data.frame(ID = 1:1000,
                 SEX = sample(0:1, 1000, replace = TRUE),
                 PV  = rnorm(1000),
                 GAN = rnorm(1000),
                 GAE = rnorm(1000))
newcols <- unlist(lapply(c("GT_rs", "N_rs", "E_rs"), paste0, sample(100, 50)))
df[newcols] <- replicate(50, rnorm(1000))

df

Answer 2

您可以通過將字符串粘貼在一起來構建公式 - 我們只需要知道您想要粘貼在一起的字符串。

這應該有效 - 它未經測試，因為您共享的數據未與dput共享，因此不可復制/粘貼，並且它只有一組協變量，因此無法說明問題的復雜性。 如果你有問題，請分享復制/粘貼數據來說明，我會嘗試調試。

library(stringr)
library(dplyr)
library(broom)
# get all unique strings after underscores from your column names
suffix = str_extract(names(dfA), "_.*") %>% na.omit %>% unique
prefix = c("GT", "N")
base_formula = "PV ~ SEX + GAN +"
full_formula = paste(base_formula, paste0(prefix[1], suffix), "+", paste0(prefix[2], suffix))

mods = list()
for(i in seq_along(full_formula)) {
  mods[[suffix[i]]] = lm(as.formula(full_formula[i]), data = dfA)
}

stats = lapply(mods, tidy)
stats = bind_rows(stats, .id = "suffix")

Answer 3

由於江戶編輯了它的解決方案，我添加了它的變體：

library(purrr)
library(dplyr)
library(broom)

list("GT_rs", "N_rs") %>% 
    map(~dfA %>%  
             select(matches(paste0(.x,"\\d+"))) %>% 
             names %>% 
             sub(pattern = .x, replacement = "")) %>% 
    reduce(intersect) %>% # until here we get the variables GT_rsx, N_rsx
    sprintf("PV ~ SEX + GAN + GT_rs%s + N_rs%s", ., .) %>%
    map(lm, data = dfA) %>%
    map_dfr(tidy, .id = "model") %>% 
    group_by(model) %>% 
    mutate(suffix = sub("N_rs", "", term[grepl("^N_rs\\d+$", term)]))