R:如何只为分类变量的顶层获取虚拟变量?

R: how to get dummy variables only for top levels of a categorical variable?

我有如下数据框,

library(janitor)
library(dplyr)
set.seed(100)
data <- data_frame(var = sample(c("A", "B", "C"), 20, replace = TRUE))

   > data
# A tibble: 20 × 1
     var
   <chr>
1      A
2      A
3      B
4      A
5      B
6      B
7      C
8      B
9      B
10     A
11     B
12     C
13     A
14     B
15     C
16     C
17     A
18     B
19     B
20     C

我想创建对应于 var 的每个级别的 虚拟变量 ,但有一个问题: 我想将虚拟对象的创建限制为 var 的最高 n 级别。原因很简单:在我的数据集中,var.

有成千上万个不同的级别

也就是说,如果这里n = 2,它只会为BA创建假人,如下面的频率table所示。

> janitor::tabyl(data,var , sort = TRUE)
  var n percent
1   B 9    0.45
2   A 6    0.30
3   C 5    0.25

我怎样才能以最简洁的方式做到这一点?像往常一样,输出类似于

dummy_B   dummy_A
0         1
0         1
1         0
0         1

谢谢!

更新答案

考虑到大数据方面,您可以定义一个函数来执行此操作。可能不是很有效,但只会 return 所需的列数。

model_matrix <- function(variable, data, numlevels, end = TRUE) {
  tmp <- table(data[variable])
  if(end) {
    lvl <- unlist(attr(tmp, 'dimnames'))[(length(tmp)-numlevels+1):length(tmp)]
  } else {
    lvl <- unlist(attr(tmp, 'dimnames'))[1:numlevels]
  }  
  mat <- data.frame(do.call("cbind", 
      lapply(seq_along(lvl), function(xx) ifelse(data[variable] == lvl[xx], 1, 0))
  ))
  names(mat) <- paste0('var', lvl)
  mat
}

现在您可以运行:

library(tibble)
set.seed(100)
data <- data_frame(var = sample(c("A", "B", "C"), 20, replace = TRUE))
model_matrix('var', data, 2, end = TRUE)

这种方法的好处是它应该泛化到更多变量,如下所示

data <- data_frame(var = sample(c("A", "B", "C"), 20, replace = TRUE),
                   var2 = sample(c('D', 'E', 'F'), 20, replace = TRUE))
vars <- c('var', 'var2')
lapply(vars, model_matrix, data = data, numlevels = 2)

旧答案

我会使用 model.matrix,然后直接使用 select 您想要的列。

library(tibble)
set.seed(100)
data <- data_frame(var = sample(c("A", "B", "C"), 20, replace = TRUE))

model.matrix(~var, data)

阅读了您的大数据问题后,这是我修改后的解决方案:

n     <- 2    # set your n here
data1 <- data # I just did this step for testing; it's totally optional
data1$var[! data1$var %in% tabyl(data,var , sort = TRUE)$var[1:n]] <- NA

booya           <- model.matrix(~var-1, data1)
head(booya)
  varA varB
1    0    1
4    1    0
5    1    0
6    1    0
7    0    1
8    1    0

请注意,您不需要创建数据对象的额外副本;我这样做只是为了我自己的目的。如果您不想弄乱原来的 var 列,您可以创建一个新列或字符向量。

这是我最初的尝试,对大数据不利:

n <- 2 # set your n here

tmp           <- model.matrix(~var-1, data)
colnames(tmp) <- gsub("^[[:alpha:]]", "", colnames(tmp))
colnames(tmp) <- gsub("^[[:alpha:]]", "", colnames(tmp))
colnames(tmp) <- gsub("^[[:alpha:]]", "", colnames(tmp))
final         <- tmp[, colnames(tmp)%in%tabyl(data,var , sort = TRUE)$var[1:n]]

head(final)
  A B
1 0 1
2 0 0
3 0 0
4 1 0
5 1 0
6 1 0

这个怎么样?

set.seed(100)
data <- data_frame(var = sample(c("A", "B", "C"), 20, replace = TRUE))

# Number of levels
n <- 2
bind_cols(
  data, 
  data %>% 
    group_by(var) %>% 
    summarise(total=n()) %>%
    top_n(n, total) %>% 
    select(var) %>% `[[`(1) %>%
    sapply(function(x) (data$var == x) * 1) %>%
    as_data_frame())

# data %>% `[[`(1) is equal to data[[1]]

这个答案可能有点乱,

dummy_top_n <- function(data_frame, column, n){
  order_vec <- vector()
  for ( i in 0:(n-1)){
    order_vec <- c(order_vec,names(sort(table(data_frame[,column]),
             partial=length(table(data_frame[,column])) - i )[length(table(data_frame[,column])) - i ]))
  }
  colnames(data_frame)[which(colnames(data_frame) == column)] <- 'dummy_'
  dummies <- model.matrix(~ dummy_ - 1, data=data_frame)
  return(dummies[,rev(which(names(table(data_frame)) %in% order_vec ))])
}

dummy_top_n(data, 'var',2)