使用 tidyverse 动词将以下函数翻译为基础 R 作为函数答案

【问题标题】：Translating the following function using tidyverse verbs into base R as a function使用 tidyverse 动词将以下函数翻译为基础 R 作为函数
【发布时间】：2023-03-13 12:25:01
【问题描述】：

我正在尝试将tidyverse 中的以下语法作为函数转换为base R，尽管我在遵循相同的输出时遇到了困难。

语法如下：

x <- function(x) {x %>% 
    select(where(negate(is.numeric))) %>% 
    map_dfc(~ model.matrix(~ .x -1) %>% 
              as_tibble) %>% 
    rename_all(~ str_remove(., "\\.x")) 
}

我知道select 可以表示为dataframe 中的索引，例如x[,]。至于管道函数%>%，我可以在变量中索引一个函数，即x <- ...

我可以转移select(where(negate(is.numeric)))

进入：

x <- function(x){
  x[, !sapply(x, is.numeric)]
  
}

不过，这很困难，因为我认为可以将其替换为条件参数：

 map_dfc(~ model.matrix(~ .x -1)

这是带有一些示例数据的预期输出：

# A tibble: 12 x 5
   black brown white female  male
   <dbl> <dbl> <dbl>  <dbl> <dbl>
 1     1     0     0      1     0
 2     1     0     0      1     0
 3     1     0     0      1     0
 4     1     0     0      1     0
 5     0     0     1      1     0
 6     0     0     1      1     0
 7     0     0     1      0     1
 8     0     0     1      0     1
 9     0     1     0      0     1
10     0     1     0      0     1
11     0     1     0      0     1
12     0     1     0      0     1

可重现的代码：

structure(list(wgt = c(64L, 71L, 53L, 67L, 55L, 58L, 77L, 57L, 
56L, 51L, 76L, 68L), hgt = c(57L, 59L, 49L, 62L, 51L, 50L, 55L, 
48L, 42L, 42L, 61L, 57L), age = c(8L, 10L, 6L, 11L, 8L, 7L, 10L, 
9L, 10L, 6L, 12L, 9L), id = structure(c(1L, 1L, 1L, 1L, 3L, 3L, 
3L, 3L, 2L, 2L, 2L, 2L), .Label = c("black", "brown", "white"
), class = "factor"), sex = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
2L, 2L, 2L, 2L, 2L, 2L), .Label = c("female", "male"), class = "factor")), class = "data.frame", row.names = c(NA, 
-12L))

【问题讨论】：

标签： r tidyverse translation

【解决方案1】：

1) 如果input 是输入数据框，则定义一个模型矩阵函数 mm 并将其应用于非数字列，并将它们组合成一个数据框。最后把名字改好。

mm <- function(x) model.matrix(~ x - 1)
result <- do.call("data.frame", lapply(Filter(Negate(is.numeric), input), mm))
names(result) <- sub(".*\\.x", "", names(result))
result

给予：

   black brown white female male
1      1     0     0      1    0
2      1     0     0      1    0
3      1     0     0      1    0
4      1     0     0      1    0
5      0     0     1      1    0
6      0     0     1      1    0
7      0     0     1      0    1
8      0     0     1      0    1
9      0     1     0      0    1
10     0     1     0      0    1
11     0     1     0      0    1
12     0     1     0      0    1

2) 为了使它类似于 tidyverse 版本，我们可以使用不需要任何包的 Bizarro 管道。

input ->.;
  Filter(Negate(is.numeric), .) ->.;
  lapply(., function(x) model.matrix(~ x - 1)) ->.;
  do.call("data.frame", .) ->.;
  setNames(., sub(".*\\.x", "", names(.))) -> result
result

【讨论】：

【解决方案2】：

调用您的输入数据xx，

onehot = function(data) {
  x = Filter(Negate(is.numeric), data)
  x = as.data.frame(Reduce(cbind, lapply(x, function(col) model.matrix(~ . - 1, data = data.frame(col)))))
  setNames(x, sub(pattern = "^col", replacement = "", names(x)))
}

onehot(xx)
#    black brown white female male
# 1      1     0     0      1    0
# 2      1     0     0      1    0
# 3      1     0     0      1    0
# 4      1     0     0      1    0
# 5      0     0     1      1    0
# 6      0     0     1      1    0
# 7      0     0     1      0    1
# 8      0     0     1      0    1
# 9      0     1     0      0    1
# 10     0     1     0      0    1
# 11     0     1     0      0    1
# 12     0     1     0      0    1

还有其他包像这样进行 one-hot 编码，see here for some examples，但以上都是基础。

【讨论】：