使用 purrr::map2 具有所有变量排列的模型

Posted 2023-03-15

【中文标题】使用 purrr::map2 具有所有变量排列的模型

【英文标题】：Models with all variable permutations using purrr::map2

【发布时间】：2022-01-07 16:09:45

【问题描述】：

以下代码为我提供了模型 a <- c 和 b <- d，但我想知道如何修改它以使其也具有 a <- d 和 b <- c

outcomes <- df %>%
   select(a, b)
predictors <- df %>%
   select(c, d)
model <- function(outcomes, predictors) lm(outcomes ~ predictors)
map2(outcomes, predictors, model)``` 

【问题讨论】：

您不需要for-loop 甚至map。只需重塑您的数据并为整个数据集做一个 lm

【参考方案1】：

我想出了这个：

map(packs, library, character.only = TRUE) 

df <- tibble(a = 1:100, b = a^3, c = b/33, d = a/3) 
outcomes <- df %>%
   select(a, b)
predictors <- df %>%
   select(c, d)
map(outcomes, function(x) map(predictors, function(y) lm(x ~ y)))```

【参考方案2】：

为此，您不需要 for 循环甚至映射。只需重塑您的数据并为整个数据集做一个 lm。检查以下示例：

data <- head(iris[-5], 6)
 
indep <- c('Sepal.Length',  'Petal.Length')
dep <- c('Sepal.Width',  'Petal.Width')

现在运行所有模型：

data %>%
  pivot_longer(all_of(indep))%>%
  lm(as.matrix(.[dep])~0 + name/value, .)

Call:
lm(formula = as.matrix(.[dep]) ~ 0 + name/value, data = .)

Coefficients:
                        Sepal.Width  Petal.Width
namePetal.Length         1.1702      -0.5298    
nameSepal.Length        -1.6859      -0.8402    
namePetal.Length:value   1.5263       0.5263    
nameSepal.Length:value   1.0241       0.2169   

结果如下：

前两行是截距，后两行是 B1 系数。比较：

lm(Sepal.Width~Petal.Length, data)

Call:
lm(formula = Sepal.Width ~ Petal.Length, data = data)

Coefficients:
 (Intercept)  Petal.Length  
       1.170         1.526  

lm(Sepal.Width~Sepal.Length, data)

Call:
lm(formula = Sepal.Width ~ Sepal.Length, data = data)

Coefficients:
 (Intercept)  Sepal.Length  
      -1.686         1.024  

现在你可以和Petal.Width比较

【参考方案3】：

假设哪些变量将是自变量或因变量是固定的。在这种情况下，a 和 b 将是因变量，c 和 d 将是自变量。

你可以试试

df <- data.frame(
  a = 1:4,
  b = 2:5,
  c = rnorm(4),
  d = runif(4)
)
dep <- c("a", "b")
indep <- c("c", "d")

indep <- gtools::permutations(n = 2, r = 2, v = indep)

df %>%
  select(dep)

df %>%
  select(indep[1,])

modlist <- list()
for (i in 1:nrow(indep))
  outcomes <- df %>%
    select(dep)
  predictors_ <- df %>%
    select(indep[i,])
  fit <- function(outcomes, predictors_) lm(outcomes ~ predictors_)
  modlist[[i]] <- map2(outcomes, predictors_, fit) 

modlist

[[1]]
[[1]]$a

Call:
lm(formula = outcomes ~ predictors_)

Coefficients:
(Intercept)  predictors_  
     2.4296      -0.2222  


[[1]]$b

Call:
lm(formula = outcomes ~ predictors_)

Coefficients:
(Intercept)  predictors_  
      2.058        2.631  



[[2]]
[[2]]$a

Call:
lm(formula = outcomes ~ predictors_)

Coefficients:
(Intercept)  predictors_  
      1.058        2.631  


[[2]]$b

Call:
lm(formula = outcomes ~ predictors_)

Coefficients:
(Intercept)  predictors_  
     3.4296      -0.2222