从系数和变量的 R 数据帧创建公式

Question

我正在尝试创建一个函数，formulator，以从包含响应、系数和常量以及函数名称的数据帧中创建 R 公式。我的目的是在将大量历史函数转换为可用的 R 代码时使用它。将每个函数重写为(response ~ constant + b1 x x1 + b2 x x2.....)

既繁琐又容易出错

具有相同变量的示例数据框，但对于每种情况，并非每个变量都是有趣的（例如，未使用时为 NA）。每个函数都有自己的行，每个部分都有自己的列，其中列名是变量，单元格是系数。并非所有系数都是正数。

structure(list(species = c("Pine", "Spruce", "Birch", "Aspen", 
"Beech", "Oak", "Noble", "Trivial"), constant = c(-1.6952, -2.2827, 
-0.2269, -0.8198, 0.2081, 0.2348, 0.485, 1.9814), lndp1 = c(1.1617, 
1.4354, 1.1891, 1.4839, 1.7491, 1.2141, 1.0318, 0.8401), d = c(-0.0354, 
-0.0389, -0.0435, -0.024, -0.2167, NA, NA, NA), d2gt = c(0.2791, 
0.3106, 0.562, NA, NA, NA, NA, NA)), row.names = c(NA, -8L), class = c("tbl_df", 
"tbl", "data.frame"))

我的想法是，因为它是有序的，我可以编写一个函数来为我做这件事，并用如下打印输出回复：

data %>% formulator(name_column=species, intercept_column=constant, response="Unknown")

在这种情况下，没有已知的响应变量列，但我可能知道此数据框中的所有行都有相同的响应，这对于在引号中手动输入可能很有用（tidyeval 问题？）。

Pine
Unknown ~ -1.6952 + 1.1617 x lndp1 + -0.0354 x d ....

Spruce
Unknown ~ ...

到目前为止，这是我的想法：

formulator <- function(data, name_column, intercept_column){
  data1 <- data %>% select(-c(name_column, intercept_column))
  function_name <- data[,paste0(name_column)]
  intercepts <- data[,paste0(intercept_column)]

  varlist <- list()

  for(i in 1:dim(data1)[1]){
    data2 <- data1 %>% filter(name_column == paste0(function_name$i)) %>%  select_if(~!any(is.na(.)))
    datadim <- dim(data2)[2]
    for(coefs in 1:datadim){
      varlist[paste0(function_name$i)][coefs] <- paste0(data2[1,coefs])

    }
  }


}

此代码不完整，但我认为可以处理每个要打印的函数的不同长度，但我不确定如何将所有这些联系在一起。

Answer 1

我可能建议创建存储为命名向量的公式的文本版本，然后在需要公式时使用 as.formula(textVersion["foo"])。这里有一些代码可以为您提供思路...

library(tibble)
library(dplyr)

formulaData = tibble(
  species = c("Pine", "Spruce", "Birch", "Aspen", "Beech", "Oak", "Noble", "Trivial"), 
  constant = c(-1.6952, -2.2827, -0.2269, -0.8198, 0.2081, 0.2348, 0.485, 1.9814), 
  lndp1 = c(1.1617, 1.4354, 1.1891, 1.4839, 1.7491, 1.2141, 1.0318, 0.8401), 
  d = c(-0.0354, -0.0389, -0.0435, -0.024, -0.2167, NA, NA, NA),
  d2gt = c(0.2791, 0.3106, 0.562, NA, NA, NA, NA, NA)
)

rhs = 
  formulaData %>%
  select(!constant) %>%
  group_by(species) %>%
  group_map(
    function(x,y) 
      x[,!is.na(as.numeric(x))] %>%
      unlist %>%
      paste(names(.), sep = "*", collapse = " + ")
  ) %>%
  unlist %>%
  paste(" + ", formulaData$constant)

textVersion = 
  paste("x ~", rhs) %>%
  structure(names = sort(formulaData$species))

示例结果：

> textVersion
                                                  Aspen 
              "x ~ 1.4839*lndp1 + -0.024*d  +  -1.6952" 
                                                  Beech 
             "x ~ 1.7491*lndp1 + -0.2167*d  +  -2.2827" 
                                                  Birch 
"x ~ 1.1891*lndp1 + -0.0435*d + 0.562*d2gt  +  -0.2269" 
                                                  Noble 
                         "x ~ 1.0318*lndp1  +  -0.8198" 
                                                    Oak 
                          "x ~ 1.2141*lndp1  +  0.2081" 
                                                   Pine 
"x ~ 1.1617*lndp1 + -0.0354*d + 0.2791*d2gt  +  0.2348" 
                                                 Spruce 
 "x ~ 1.4354*lndp1 + -0.0389*d + 0.3106*d2gt  +  0.485" 
                                                Trivial 
                          "x ~ 0.8401*lndp1  +  1.9814"

和

> as.formula(textVersion["Oak"])
x ~ 1.2141 * lndp1 + 0.2081

如果你真的想要一个 formulator 函数，returns 一个公式，我会转置你的小标题：

transposedData = 
  formulaData %>%
  select(!species) %>%
  unlist %>%
  matrix(ncol = 4, dimnames = list(formulaData$species, names(formulaData)[-1])) %>%
  t %>%
  as_tibble %>%
  mutate(term = names(formulaData)[-1]) %>%
  relocate(term, before = Pine)

看起来像这样：

> transposedData
# A tibble: 4 x 9
  term        Pine  Spruce   Birch  Aspen  Beech    Oak  Noble Trivial
  <chr>      <dbl>   <dbl>   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>   <dbl>
1 constant -1.70   -2.28   -0.227  -0.820  0.208  0.235  0.485   1.98 
2 lndp1     1.16    1.44    1.19    1.48   1.75   1.21   1.03    0.840
3 d        -0.0354 -0.0389 -0.0435 -0.024 -0.217 NA     NA      NA    
4 d2gt      0.279   0.311   0.562  NA     NA     NA     NA      NA

那么功能就很简单了。类似于：

formulator = function(.data, ID, lhs, constant = "constant") {
  terms = structure(
    paste(.data[[ID]], .data$term, sep = "*"),
    names = .data$term
  )
  terms = terms[!is.na(.data[[ID]])]
  cnst = which(names(terms) == constant)
  terms[cnst] = .data[[ID]][cnst]
  rhs = paste(terms, collapse = " + ")
  textVersion = paste(lhs, "~", rhs)
  as.formula(textVersion, env = parent.frame())
}

这是一个示例应用程序：

> formulator(transposedData, "Beech", "myVariable")
myVariable ~ 0.2081 + 1.7491 * lndp1 + -0.2167 * d

我不确定我是否完全理解您的问题或我编写的函数是否是您想要的，但是有一些编码示例可能会帮助您设计解决方案。

从系数和变量的 R 数据帧创建公式

Create formulas from R dataframe of coefficients and variables

for-loop

r

dplyr

purrr

tidyeval