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
,它只会为B
和A
创建假人,如下面的频率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)
我有如下数据框,
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
,它只会为B
和A
创建假人,如下面的频率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)