自动将 R 因子展开为每个因子级别的1/0指示变量的集合

我有一个 R 数据框架,其中包含一个我想要“展开”的因子,因此对于每个因子级别,在一个新的数据框架中都有一个相关联的列,其中包含1/0指示符。例如,假设我有:

df.original <-data.frame(eggs = c("foo", "foo", "bar", "bar"), ham = c(1,2,3,4))

我想要:

df.desired  <- data.frame(foo = c(1,1,0,0), bar=c(0,0,1,1), ham=c(1,2,3,4))

因为对于某些分析,你需要一个完全数字化的数据框架(例如,主成分分析) ,我认为这个特性可能是内置的。为此编写一个函数应该不会太难,但是我可以预见到与列名相关的一些挑战,如果已经存在某些东西,我宁愿使用它。

58852 次浏览

可能虚拟变量与您想要的类似。 那么,model. Matrix 是有用的:

> with(df.original, data.frame(model.matrix(~eggs+0), ham))
eggsbar eggsfoo ham
1       0       1   1
2       0       1   2
3       1       0   3
4       1       0   4

使用 model.matrix函数:

model.matrix( ~ Species - 1, data=iris )

如果你的数据框架只由因子组成(或者你正在处理一个变量的子集,这些变量都是因子) ,你也可以使用 ade4包中的 acm.disjonctif函数:

R> library(ade4)
R> df <-data.frame(eggs = c("foo", "foo", "bar", "bar"), ham = c("red","blue","green","red"))
R> acm.disjonctif(df)
eggs.bar eggs.foo ham.blue ham.green ham.red
1        0        1        0         0       1
2        0        1        1         0       0
3        1        0        0         1       0
4        1        0        0         0       1

不完全是你所描述的情况,但它也可以是有用的..。

A quick way using the reshape2 package:

require(reshape2)


> dcast(df.original, ham ~ eggs, length)


Using ham as value column: use value_var to override.
ham bar foo
1   1   0   1
2   2   0   1
3   3   1   0
4   4   1   0

请注意,这将准确地生成所需的列名。

刚刚碰到这个老线程,我想添加一个函数,利用 ade4获取一个由因子和/或数值数据组成的数据框,并返回一个以因子作为虚拟代码的数据框。

dummy <- function(df) {


NUM <- function(dataframe)dataframe[,sapply(dataframe,is.numeric)]
FAC <- function(dataframe)dataframe[,sapply(dataframe,is.factor)]


require(ade4)
if (is.null(ncol(NUM(df)))) {
DF <- data.frame(NUM(df), acm.disjonctif(FAC(df)))
names(DF)[1] <- colnames(df)[which(sapply(df, is.numeric))]
} else {
DF <- data.frame(NUM(df), acm.disjonctif(FAC(df)))
}
return(DF)
}

我们试试吧。

df <-data.frame(eggs = c("foo", "foo", "bar", "bar"),
ham = c("red","blue","green","red"), x=rnorm(4))
dummy(df)


df2 <-data.frame(eggs = c("foo", "foo", "bar", "bar"),
ham = c("red","blue","green","red"))
dummy(df2)

nnet包中的后期条目 class.ind

library(nnet)
with(df.original, data.frame(class.ind(eggs), ham))
bar foo ham
1   0   1   1
2   0   1   2
3   1   0   3
4   1   0   4

我需要一个“爆炸”因子的函数,这个函数比较灵活,并且基于 ade4包中的 acm.disjonctif 函数创建了一个函数。 这允许您选择爆炸值,即 acm.disjonctif 中的0和1。它只会爆发出“少数”层次的因素。保留数字列。

# Function to explode factors that are considered to be categorical,
# i.e., they do not have too many levels.
# - data: The data.frame in which categorical variables will be exploded.
# - values: The exploded values for the value being unequal and equal to a level.
# - max_factor_level_fraction: Maximum number of levels as a fraction of column length. Set to 1 to explode all factors.
# Inspired by the acm.disjonctif function in the ade4 package.
explode_factors <- function(data, values = c(-0.8, 0.8), max_factor_level_fraction = 0.2) {
exploders <- colnames(data)[sapply(data, function(col){
is.factor(col) && nlevels(col) <= max_factor_level_fraction * length(col)
})]
if (length(exploders) > 0) {
exploded <- lapply(exploders, function(exp){
col <- data[, exp]
n <- length(col)
dummies <- matrix(values[1], n, length(levels(col)))
dummies[(1:n) + n * (unclass(col) - 1)] <- values[2]
colnames(dummies) <- paste(exp, levels(col), sep = '_')
dummies
})
# Only keep numeric data.
data <- data[sapply(data, is.numeric)]
# Add exploded values.
data <- cbind(data, exploded)
}
return(data)
}

这里有一个更清楚的方法来做到这一点。我使用 model.Matrix 创建虚拟的布尔变量,然后将其合并回原始数据框架。

df.original <-data.frame(eggs = c("foo", "foo", "bar", "bar"), ham = c(1,2,3,4))
df.original
#   eggs ham
# 1  foo   1
# 2  foo   2
# 3  bar   3
# 4  bar   4


# Create the dummy boolean variables using the model.matrix() function.
> mm <- model.matrix(~eggs-1, df.original)
> mm
#   eggsbar eggsfoo
# 1       0       1
# 2       0       1
# 3       1       0
# 4       1       0
# attr(,"assign")
# [1] 1 1
# attr(,"contrasts")
# attr(,"contrasts")$eggs
# [1] "contr.treatment"


# Remove the "eggs" prefix from the column names as the OP desired.
colnames(mm) <- gsub("eggs","",colnames(mm))
mm
#   bar foo
# 1   0   1
# 2   0   1
# 3   1   0
# 4   1   0
# attr(,"assign")
# [1] 1 1
# attr(,"contrasts")
# attr(,"contrasts")$eggs
# [1] "contr.treatment"


# Combine the matrix back with the original dataframe.
result <- cbind(df.original, mm)
result
#   eggs ham bar foo
# 1  foo   1   0   1
# 2  foo   2   0   1
# 3  bar   3   1   0
# 4  bar   4   1   0


# At this point, you can select out the columns that you want.

(问题是10yo,但为了完整起见...)

The function i() from the fixest package does exactly that.

除了用因子类变量创建设计矩阵外,你还可以很容易地在运行中做两件额外的事情:

  • 装入值(使用参数“ bin”) ,
  • 不包括一些因子值(使用参数 ref)。

因为它是为这个任务而生的,所以如果您的变量碰巧是数值型的,那么您就不需要用 factor(x_num)来包装它(与 model.matrix解决方案相反)。

这里有一个例子:

library(fixest)
data(airquality)
table(airquality$Month)
#>  5  6  7  8  9
#> 31 30 31 31 30


head(i(airquality$Month))
#>      5 6 7 8 9
#> [1,] 1 0 0 0 0
#> [2,] 1 0 0 0 0
#> [3,] 1 0 0 0 0
#> [4,] 1 0 0 0 0
#> [5,] 1 0 0 0 0
#> [6,] 1 0 0 0 0


#
# Binning (check out the help, there are many many ways to bin)
#


colSums(i(airquality$Month, bin = 5:6)))
#>  5  7  8  9
#> 61 31 31 30


#
# References
#


head(i(airquality$Month, ref = c(6, 9)), 3)
#>      5 7 8
#> [1,] 1 0 0
#> [2,] 1 0 0
#> [3,] 1 0 0

下面是一个扩展所有非数值变量的小包装器(默认情况下) :

library(fixest)


# data: data.frame
# var: vector of variable names // if missing, all non numeric variables
# no argument checking
expand_factor = function(data, var){
    

if(missing(var)){
var = names(data)[!sapply(data, is.numeric)]
if(length(var) == 0) return(data)
}
    

data_list = unclass(data)
new = lapply(var, \(x) i(data_list[[x]]))
data_list[names(data_list) %in% var] = new
    

do.call("cbind", data_list)
}


my_data = data.frame(eggs = c("foo", "foo", "bar", "bar"), ham = c(1,2,3,4))


expand_factor(my_data)
#>      bar foo ham
#> [1,]   0   1   1
#> [2,]   0   1   2
#> [3,]   1   0   3
#> [4,]   1   0   4

最后,对于那些想知道的人来说,时机与 model.matrix解决方案相当。

library(microbenchmark)
my_data = data.frame(x = as.factor(sample(100, 1e6, TRUE)))


microbenchmark(mm = model.matrix(~x, my_data),
i = i(my_data$x), times = 5)
#> Unit: milliseconds
#>  expr      min       lq     mean   median       uq      max neval
#>    mm 155.1904 156.7751 209.2629 182.4964 197.9084 353.9443     5
#>     i 154.1697 154.7893 159.5202 155.4166 163.9706 169.2550     5


sapply中,==优于 鸡蛋可以用来生成虚拟向量:

x <- with(df.original, data.frame(+sapply(unique(eggs), `==`, eggs), ham))
x
#  foo bar ham
#1   1   0   1
#2   1   0   2
#3   0   1   3
#4   0   1   4


all.equal(x, df.desired)
#[1] TRUE

一个可能更快的变体-结果最好用作 listdata.frame:

. <- unique(df.original$eggs)
with(df.original,
data.frame(+do.call(cbind, lapply(setNames(., .), `==`, eggs)), ham))

matrix中建立索引-最好用作 matrix的结果:

. <- unique(df.original$eggs)
i <- match(df.original$eggs, .)
nc <- length(.)
nr <- length(i)
cbind(matrix(`[<-`(integer(nc * nr), 1:nr + nr * (i - 1), 1), nr, nc,
dimnames=list(NULL, .)), df.original["ham"])

使用 outer-结果最好用作 matrix:

. <- unique(df.original$eggs)
cbind(+outer(df.original$eggs, setNames(., .), `==`), df.original["ham"])

使用 rep-结果最好用作 matrix:

. <- unique(df.original$eggs)
n <- nrow(df.original)
cbind(+matrix(df.original$eggs == rep(., each=n), n, dimnames=list(NULL, .)),
df.original["ham"])