以奇怪的方式应用 dcast
Applying dcast in a weird way
我想根据"lead"变量来分隔变量。在以下情况下为 x3:
set.seed(2)
df = data.frame(x1 = sample(4), x2 = sample(4), x3 = sample(letters[1:2], size = 4, replace = TRUE))
df
# x1 x2 x3
# 1 1 4 a
# 2 3 3 b
# 3 2 1 b
# 4 4 2 a
# Desired output
# x3 x1.a x2.a x1.b x2.b
# a 1 4 NA NA
# b NA NA 3 3
# b NA NA 2 1
# a 4 2 NA NA
我以某种方式感觉到这可以通过 reshape2::dcast()
实现,但我总共只能让它对两个变量起作用:
reshape2::dcast(df[,2:3], seq_along(x3) ~ x3, value.var = "x2")[, -1]
# a b
# 1 2 NA
# 2 NA 1
# 3 NA 3
# 4 4 NA
但这可能只是对 dcast
的完全滥用。这个问题有没有优雅的解法,不用拆分和合并df
?
编辑: 有些人提到这样做是一个可怕的想法,我可能不应该做这样的事情。让我详细说明这何时有意义。
假设x3
是特定算法的开关。在这种情况下,a
和 b
是选项。此外,x1
和 x2
是两种算法都可以采用的参数。不幸的是,这两种算法在 x1
和 x2
的相同参数设置上表现得非常不同,因此将它们作为不同的特征来处理以考虑它们的不相关性是有意义的。
这是一个使用 X3
创建虚拟交互项的解决方案。使用 dplyr
或 data.table
可能可以将所有这些代码放在一行中,但这里是:
temp <- model.matrix( ~ (x1+x2):x3-1, df)
temp[model.matrix( ~ (I(x1+1)+I(x2+1)):x3-1, df) == temp] <- NA
data.frame(df$x3, temp)
#### df.x3 x1.x3a x1.x3b x3a.x2 x3b.x2
#### a 1 NA 4 NA
#### b NA 3 NA 3
#### b NA 2 NA 1
#### a 4 NA 2 NA
列的最终名称和顺序与您略有不同。
注意:(第二行代码的目的)。
model.matrix 函数创建零而不是 NAs
,因此无法区分与预先存在的零的区别。第二行是仅查找最终 NA 的技巧(它通过创建第二个模型矩阵同时通过 +1
更改其值来工作)。
这可以使用 melt
和 dcast
来实现,如果你再添加一列并做一个中介 melt
。
library(reshape2)
library(magrittr)
set.seed(2)
df = data.frame(x1 = sample(4), x2 = sample(4), x3 = sample(letters[1:2], size = 4, replace = TRUE))
df$row <- 1:nrow(df)
melt(df,
id.vars = c("row", "x3"),
measure.vars = c("x1", "x2")) %>%
dcast(row ~ x3 + variable,
value.var = "value")
但是,它的运行速度比 agenis 的解决方案慢 2-3 倍,即使我将数据框的大小推高至 10,000 行也是如此。 (8 与 16 毫秒)。
我自己想出的一个基本解决方案:
cat.var = "x3"
cont.vars = setdiff(colnames(df), cat.var)
categories = unique(df[[cat.var]])
res = lapply(categories, function(x) {
this.df = df[, cont.vars, drop = FALSE]
this.df[df[[cat.var]] != x,] = NA
setNames(this.df, paste0(x,".",colnames(this.df)))
})
res = do.call(cbind, c(list(df[, cat.var, drop=FALSE]), res))
res
# x3 a.x1 a.x2 b.x1 b.x2
# 1 a 1 4 NA NA
# 2 b NA NA 3 3
# 3 b NA NA 2 1
# 4 a 4 2 NA NA
你可以使用 tidyr
library(tidyr);library(dplyr)
df <- df %>% mutate(rows=rownames(.)) %>%
gather(., key="vars", value= "val", -x3,-rows) %>%
mutate(vars= paste(x3,vars, sep=".")) %>%
spread(., key = vars, value = val) %>%
select(-rows)
它将数据集收集成长格式,将 x3 变量分开,然后在创建您需要的变量 headers 后,再次传播数据。
我想根据"lead"变量来分隔变量。在以下情况下为 x3:
set.seed(2)
df = data.frame(x1 = sample(4), x2 = sample(4), x3 = sample(letters[1:2], size = 4, replace = TRUE))
df
# x1 x2 x3
# 1 1 4 a
# 2 3 3 b
# 3 2 1 b
# 4 4 2 a
# Desired output
# x3 x1.a x2.a x1.b x2.b
# a 1 4 NA NA
# b NA NA 3 3
# b NA NA 2 1
# a 4 2 NA NA
我以某种方式感觉到这可以通过 reshape2::dcast()
实现,但我总共只能让它对两个变量起作用:
reshape2::dcast(df[,2:3], seq_along(x3) ~ x3, value.var = "x2")[, -1]
# a b
# 1 2 NA
# 2 NA 1
# 3 NA 3
# 4 4 NA
但这可能只是对 dcast
的完全滥用。这个问题有没有优雅的解法,不用拆分和合并df
?
编辑: 有些人提到这样做是一个可怕的想法,我可能不应该做这样的事情。让我详细说明这何时有意义。
假设x3
是特定算法的开关。在这种情况下,a
和 b
是选项。此外,x1
和 x2
是两种算法都可以采用的参数。不幸的是,这两种算法在 x1
和 x2
的相同参数设置上表现得非常不同,因此将它们作为不同的特征来处理以考虑它们的不相关性是有意义的。
这是一个使用 X3
创建虚拟交互项的解决方案。使用 dplyr
或 data.table
可能可以将所有这些代码放在一行中,但这里是:
temp <- model.matrix( ~ (x1+x2):x3-1, df)
temp[model.matrix( ~ (I(x1+1)+I(x2+1)):x3-1, df) == temp] <- NA
data.frame(df$x3, temp)
#### df.x3 x1.x3a x1.x3b x3a.x2 x3b.x2
#### a 1 NA 4 NA
#### b NA 3 NA 3
#### b NA 2 NA 1
#### a 4 NA 2 NA
列的最终名称和顺序与您略有不同。
注意:(第二行代码的目的)。
model.matrix 函数创建零而不是 NAs
,因此无法区分与预先存在的零的区别。第二行是仅查找最终 NA 的技巧(它通过创建第二个模型矩阵同时通过 +1
更改其值来工作)。
这可以使用 melt
和 dcast
来实现,如果你再添加一列并做一个中介 melt
。
library(reshape2)
library(magrittr)
set.seed(2)
df = data.frame(x1 = sample(4), x2 = sample(4), x3 = sample(letters[1:2], size = 4, replace = TRUE))
df$row <- 1:nrow(df)
melt(df,
id.vars = c("row", "x3"),
measure.vars = c("x1", "x2")) %>%
dcast(row ~ x3 + variable,
value.var = "value")
但是,它的运行速度比 agenis 的解决方案慢 2-3 倍,即使我将数据框的大小推高至 10,000 行也是如此。 (8 与 16 毫秒)。
我自己想出的一个基本解决方案:
cat.var = "x3"
cont.vars = setdiff(colnames(df), cat.var)
categories = unique(df[[cat.var]])
res = lapply(categories, function(x) {
this.df = df[, cont.vars, drop = FALSE]
this.df[df[[cat.var]] != x,] = NA
setNames(this.df, paste0(x,".",colnames(this.df)))
})
res = do.call(cbind, c(list(df[, cat.var, drop=FALSE]), res))
res
# x3 a.x1 a.x2 b.x1 b.x2
# 1 a 1 4 NA NA
# 2 b NA NA 3 3
# 3 b NA NA 2 1
# 4 a 4 2 NA NA
你可以使用 tidyr
library(tidyr);library(dplyr)
df <- df %>% mutate(rows=rownames(.)) %>%
gather(., key="vars", value= "val", -x3,-rows) %>%
mutate(vars= paste(x3,vars, sep=".")) %>%
spread(., key = vars, value = val) %>%
select(-rows)
它将数据集收集成长格式,将 x3 变量分开,然后在创建您需要的变量 headers 后,再次传播数据。