使用tidyverse动词将以下函数翻译为基本R作为函数
我想在翻译中发现以下语法tidyverse为baseR作为一个功能，虽然我有以下相同的输出困难。
这是语法：
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))
回答
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
回答
调用您的输入数据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
还有其他软件包可以进行这样的单热编码，请参见此处的一些示例，但以上都是基础。