使用 tidyverse 動詞將以下 function 翻譯成基礎 R 作為 function

Question

我正在嘗試將tidyverse中的以下語法轉換為base R 作為 function，盡管我在遵循相同的 output 時遇到了困難。

這是語法：

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[,] 。 至於 pipe function %>% ，我可以在變量內索引 function 即x <-...

我可以設法轉移select(where(negate(is.numeric)))

進入：

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

雖然，這很困難，因為我認為它可以用條件參數代替：

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

這是預期的 output 和一些示例數據：

# 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是輸入數據幀，定義一個 model 矩陣 function 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 pipe。

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 編碼，請參見此處的一些示例，但以上都是基礎。