使用 tidyverse 动词将以下函数转换为基础 R 作为函数

Question

我正在尝试将 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))

Answer 1

1)如果input是输入数据框，定义一个模型矩阵函数mm和lapply它到非数字列并把它们一起成为一个单一的数据框。终于确定名字了

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

Answer 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，但以上都是base。

使用 tidyverse 动词将以下函数转换为基础 R 作为函数

Translating the following function using tidyverse verbs into base R as a function

translation

r

tidyverse