在先前重塑的索引列之后重塑几组变量
Reshape several groups of variables, following a previously reshaped index column
我正在尝试在 R 中将 data.table 从宽变长。我有几组变量需要减少，但我最初一次只做一组的方法看起来非常容易出错，我想要一个替代方案。在这个可重现的示例中，我以与原始数据类似的方式创建了两组变量（XX 和 YYY）。
我的解决方案适用于此示例，但原始数据 table 的列太多，我不敢相信此代码。我不确定问题是出在我的实现中还是方法本身——如果可能的话我更愿意keep it simple。
问：有没有更好的方法解决这个问题？
示例数据
library(data.table)
dt.orig <- data.table(ID= 1:3,
a = c("Y", "Y", "N"),
b = c("N", "Y", "Y"),
XXa=c(101, 102, 103),
XXb=c(110, 120, 130),
YYYa=c(201, 202, 203),
YYYb=c(210, 220, 230))
dt.goal <- data.table(ID=c(1,1,2,2,3,3),
obs=c("a", "b"),
outcome = c("Y", "N", "Y", "Y", "N", "Y"),
XX=c(101, 110, 102, 120, 103, 130),
YYY=c(201, 210, 202, 220, 203, 230))
> dt.orig
ID a b XXa XXb YYYa YYYb
1: 1 Y N 101 110 201 210
2: 2 Y Y 102 120 202 220
3: 3 N Y 103 130 203 230
> dt.goal
ID obs outcome XX YYY
1: 1 a Y 101 201
2: 1 b N 110 210
3: 2 a Y 102 202
4: 2 b Y 120 220
5: 3 a N 103 203
6: 3 b Y 130 230
dt.orig代表原始数据，dt.goal是我想要实现的。我在 tidyr 包 vignette 之后的初步尝试如下：
尝试 1：tidyr/dplyr 方法
library(tidyr)
library(dplyr)
dt.orig[, .(ID, a, b)] %>%
pivot_longer(
cols = c("a", "b"),
names_to = "obs",
values_to = "outcome"
) %>% data.table -> dt.tidyr1
dt.orig[, .(ID, XXa, XXb, YYYa, YYYb)] %>%
pivot_longer(
cols = XXa:YYYb,
names_to = c(".value", "obs"),
names_pattern = "(XX|YYY)(.)",
) %>% data.table -> dt.tidyr2
dt.tidyr1[, .(ID, obs, outcome)] == dt.goal[, .(ID, obs, outcome)] # test passes
dt.tidyr2[, .(ID, obs, XX, YYY)] == dt.goal[, .(ID, obs, XX, YYY)] # test passes
> merge(dt.tidyr1, dt.tidyr2)
ID obs outcome XX YYY
1: 1 a Y 101 201
2: 1 b N 110 210
3: 2 a Y 102 202
4: 2 b Y 120 220
5: 3 a N 103 203
6: 3 b Y 130 230
在上面的代码中，我首先为 obs 创建一对 name/value，并从 a 和 b 中创建结果。由于所有变量组在其命名方案中都包含 a 和 b，因此我可以使用这个事实通过单个 regex.[=26= 传递所有组]
然后我可以将两个数据 table 合并或加入到最终的。
尝试 2：data.table 方式
遵循相同的原则，我可以开始将原始的 a 和 b 融合为 obs 和结果，然后对每个 var 组进行第二步（为简洁起见未在此处显示）。在这种情况下，我一次成功地熔化了一个 var 组，所以在这个例子中，首先执行所有 XX，然后执行所有 YYY。 Pros/Cons：优点是我不需要创建多个步骤 table 来完成该过程。缺点：世界上没有足够的咖啡来完成这种对实际数据中所有 var 组的方法（并相信结果）。
dt.melt1 <- melt(dt.orig,
id.vars = c("ID", "XXa", "XXb", "YYYa", "YYYb"),
measure = c("a", "b"),
variable.name = "obs",
value.name = "outcome")
我觉得dplyr版本不错。您可以使 pivot_longer 中的正则表达式更通用，以增加列数。您也可以将 a 和 b 列展平到一个列表中，这样您就不必处理制作第二个数据框和合并的问题。
# flatten cols a,b
outcome <- c(t(select(dt.orig, c(a, b))))
# pivot longer on regex and add outcome list
dt.orig %>%
pivot_longer(-c(ID, a, b),
names_to = c(".value", "obs"),
names_pattern = "(.*)(.)") %>%
mutate(outcome = outcome) %>%
select(-c(a, b))
ID obs XX YYY outcome
1 1 a 101 201 Y
2 1 b 110 210 N
3 2 a 102 202 Y
4 2 b 120 220 Y
5 3 a 103 203 N
6 3 b 130 230 Y
我认为 data.table::melt 没有自动将您的“XXa”拆分为“XX”和“a”的机制，因此您可能别无选择，只能分多个步骤进行data.table。但这里有两种替代方法来获得结果，并针对@LRRR 的 nice tidyverse 解决方案进行快速基准测试。
数据和图书馆：
library(data.table)
library(tidyverse)
library(microbenchmark)
dt.orig = data.table(ID= 1:3,
a = c("Y", "Y", "N"),
b = c("N", "Y", "Y"),
XXa=c(101, 102, 103),
XXb=c(110, 120, 130),
YYYa=c(201, 202, 203),
YYYb=c(210, 220, 230))
第一个 data.table 解决方案（包装在基准函数中）：
dt_1 <- function() {
dt = melt(dt.orig,
id.vars=c("a", "b", "ID"),
measure.vars=patterns("XX|YYY"),
variable.factor=FALSE)
dt = melt(dt,
id.vars=c("ID", "variable", "value"),
value.name="outcome",
variable.name="obs",
variable.factor=FALSE)
dt = dt[substr(variable, nchar(variable), nchar(variable)) == obs]
dt[, variable := substr(variable, 1, nchar(variable)-1)]
dcast(dt, ID + obs + outcome ~ variable)
}
第二个data.table解决方案：
dt_2 <- function() {
# ID-obs-outcome
dt1 = melt(dt.orig[, .(ID, a, b)],
id.vars="ID",
value.name="outcome",
variable.name="obs",
variable.factor=FALSE)
# ID-obs-XX-YYY
dt2 = melt(dt.orig[, !c("a", "b")],
id.vars="ID",
variable.factor=FALSE)
dt2[, obs := substr(variable, nchar(variable), nchar(variable))]
dt2[, variable := substr(variable, 1, nchar(variable)-1)]
dt2 = dcast(dt2, ID + obs ~ variable)
# merge
merge(dt1, dt2, by=c("ID", "obs"))
}
tidyverse LRRR 作为工作答案发布的解决方案：
tidy_1 <- function(){
# flatten cols a,b
outcome <- c(t(select(dt.orig, c(a, b))))
# pivot longer on regex and add outcome list
dt.orig %>%
pivot_longer(-c(ID, a, b),
names_to = c(".value", "obs"),
names_pattern = "(.*)(.)") %>%
mutate(outcome = outcome) %>%
select(-c(a, b))
}
基准：
microbenchmark(dt_1(), dt_2(), tidy_1(), times=20)
#> Unit: milliseconds
#> expr min lq mean median uq max neval cld
#> dt_1() 2.695407 2.716623 4.968294 2.900856 3.101634 43.51289 20 a
#> dt_2() 4.849555 5.027214 6.704733 5.160479 6.297621 18.93398 20 a
#> tidy_1() 13.149104 13.515273 16.439809 13.769746 15.506042 47.13444 20 b
你可以用两行实现：
dt.res <- melt(dt.orig, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
setorder(dt.res, ID)[, obs := unname(c("1" = "a", "2" = "b")[obs])]
输出
> dt.res[]
ID obs outcome XX YYY
1: 1 a Y 101 201
2: 1 b N 110 210
3: 2 a Y 102 202
4: 2 b Y 120 220
5: 3 a N 103 203
6: 3 b Y 130 230
这是上面相同代码的稍微长一点的版本
dt.res <-
melt(
dt.new2,
id.vars = "ID", measure.vars = patterns("^[ab]$", "^XX", "^YYY"),
variable.name = "obs", value.name = c("outcome", "XX", "YYY")
)
setorder(dt.res, ID)[, obs := unname(c("1" = "a", "2" = "b")[obs])]
补充说明
似乎除了 ID 列外，您还有三组列需要同时旋转：没有任何前缀的列（即 a 和 b），前缀为 XX 的那些和前缀为 YYY 的那些。如果在每组中，后缀为a的列总是出现在后缀为b的列之前，那么您可以同时melt这些列组， as data.table v1.9.6 and after 本机支持此类操作。您需要使用 regex.
指定每个列组
这就是我们 patterns("^[ab]$", "^XX", "^YYY") 的原因，它捕获我们尝试 melt 的三个列组。 melt操作后，你会得到一个data.table这样的：
ID obs outcome XX YYY
1: 1 1 Y 101 201
2: 2 1 Y 102 202
3: 3 1 N 103 203
4: 1 2 N 110 210
5: 2 2 Y 120 220
6: 3 2 Y 130 230
我们在 obs 中得到 1 和 2 而不是 a 和 b，因为 melt 操作会自动设置第一个每个组内匹配为 "1"，第二个为 "2"，依此类推。稍后我们可以通过指定 "1" = "a" 和 "2" = "b" 来重置此列。但是，您可能知道，如果带有后缀 a 的列出现在带有 b 的列之后，那么我们就不能再使用此映射 c("1" = "a", "2" = "b")。这就是为什么我们必须确保每个列组的顺序正确。
为了更好地说明这个排序问题，请参见下面的代码：
# Assume that your data.table looks like this
> dt.unordered
ID b a XXa YYYb XXb YYYa
1: 1 N Y 101 210 110 201
2: 2 Y Y 102 220 120 202
3: 3 Y N 103 230 130 203
# See the difference now?
> dt.wrong <- melt(dt.unordered, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
> dt.wrong[]
ID obs outcome XX YYY
1: 1 1 N 101 210
2: 2 1 Y 102 220
3: 3 1 Y 103 230
4: 1 2 Y 110 201
5: 2 2 Y 120 202
6: 3 2 N 130 203
因此，如果您无法确保每个组内的顺序，或许可以执行 pre-processing 来修复列顺序。这样也能得到正确的结果
> setcolorder(dt.unordered, sort(names(dt.unordered)))
> dt.fixed <- melt(dt.unordered, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
> dt.fixed[]
ID obs outcome XX YYY
1: 1 1 Y 101 201
2: 2 1 Y 102 202
3: 3 1 N 103 203
4: 1 2 N 110 210
5: 2 2 Y 120 220
6: 3 2 Y 130 230
总而言之，如果您有所有列 pre-ordered，请执行以下操作：
dt.res <- melt(dt.orig, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
setorder(dt.res, ID)[, obs := unname(c("1" = "a", "2" = "b")[obs])]
如果没有，请执行此操作：
setcolorder(dt.orig, sort(names(dt.orig)))
dt.res <- melt(dt.orig, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
setorder(dt.res, ID)[, obs := unname(c("1" = "a", "2" = "b")[obs])]
我正在尝试在 R 中将 data.table 从宽变长。我有几组变量需要减少，但我最初一次只做一组的方法看起来非常容易出错，我想要一个替代方案。在这个可重现的示例中，我以与原始数据类似的方式创建了两组变量（XX 和 YYY）。
我的解决方案适用于此示例，但原始数据 table 的列太多，我不敢相信此代码。我不确定问题是出在我的实现中还是方法本身——如果可能的话我更愿意keep it simple。
问：有没有更好的方法解决这个问题？
示例数据
library(data.table)
dt.orig <- data.table(ID= 1:3,
a = c("Y", "Y", "N"),
b = c("N", "Y", "Y"),
XXa=c(101, 102, 103),
XXb=c(110, 120, 130),
YYYa=c(201, 202, 203),
YYYb=c(210, 220, 230))
dt.goal <- data.table(ID=c(1,1,2,2,3,3),
obs=c("a", "b"),
outcome = c("Y", "N", "Y", "Y", "N", "Y"),
XX=c(101, 110, 102, 120, 103, 130),
YYY=c(201, 210, 202, 220, 203, 230))
> dt.orig
ID a b XXa XXb YYYa YYYb
1: 1 Y N 101 110 201 210
2: 2 Y Y 102 120 202 220
3: 3 N Y 103 130 203 230
> dt.goal
ID obs outcome XX YYY
1: 1 a Y 101 201
2: 1 b N 110 210
3: 2 a Y 102 202
4: 2 b Y 120 220
5: 3 a N 103 203
6: 3 b Y 130 230
dt.orig代表原始数据，dt.goal是我想要实现的。我在 tidyr 包 vignette 之后的初步尝试如下：
尝试 1：tidyr/dplyr 方法
library(tidyr)
library(dplyr)
dt.orig[, .(ID, a, b)] %>%
pivot_longer(
cols = c("a", "b"),
names_to = "obs",
values_to = "outcome"
) %>% data.table -> dt.tidyr1
dt.orig[, .(ID, XXa, XXb, YYYa, YYYb)] %>%
pivot_longer(
cols = XXa:YYYb,
names_to = c(".value", "obs"),
names_pattern = "(XX|YYY)(.)",
) %>% data.table -> dt.tidyr2
dt.tidyr1[, .(ID, obs, outcome)] == dt.goal[, .(ID, obs, outcome)] # test passes
dt.tidyr2[, .(ID, obs, XX, YYY)] == dt.goal[, .(ID, obs, XX, YYY)] # test passes
> merge(dt.tidyr1, dt.tidyr2)
ID obs outcome XX YYY
1: 1 a Y 101 201
2: 1 b N 110 210
3: 2 a Y 102 202
4: 2 b Y 120 220
5: 3 a N 103 203
6: 3 b Y 130 230
在上面的代码中，我首先为 obs 创建一对 name/value，并从 a 和 b 中创建结果。由于所有变量组在其命名方案中都包含 a 和 b，因此我可以使用这个事实通过单个 regex.[=26= 传递所有组]
然后我可以将两个数据 table 合并或加入到最终的。
尝试 2：data.table 方式
遵循相同的原则，我可以开始将原始的 a 和 b 融合为 obs 和结果，然后对每个 var 组进行第二步（为简洁起见未在此处显示）。在这种情况下，我一次成功地熔化了一个 var 组，所以在这个例子中，首先执行所有 XX，然后执行所有 YYY。 Pros/Cons：优点是我不需要创建多个步骤 table 来完成该过程。缺点：世界上没有足够的咖啡来完成这种对实际数据中所有 var 组的方法（并相信结果）。
dt.melt1 <- melt(dt.orig,
id.vars = c("ID", "XXa", "XXb", "YYYa", "YYYb"),
measure = c("a", "b"),
variable.name = "obs",
value.name = "outcome")
我觉得dplyr版本不错。您可以使 pivot_longer 中的正则表达式更通用，以增加列数。您也可以将 a 和 b 列展平到一个列表中，这样您就不必处理制作第二个数据框和合并的问题。
# flatten cols a,b
outcome <- c(t(select(dt.orig, c(a, b))))
# pivot longer on regex and add outcome list
dt.orig %>%
pivot_longer(-c(ID, a, b),
names_to = c(".value", "obs"),
names_pattern = "(.*)(.)") %>%
mutate(outcome = outcome) %>%
select(-c(a, b))
ID obs XX YYY outcome
1 1 a 101 201 Y
2 1 b 110 210 N
3 2 a 102 202 Y
4 2 b 120 220 Y
5 3 a 103 203 N
6 3 b 130 230 Y
我认为 data.table::melt 没有自动将您的“XXa”拆分为“XX”和“a”的机制，因此您可能别无选择，只能分多个步骤进行data.table。但这里有两种替代方法来获得结果，并针对@LRRR 的 nice tidyverse 解决方案进行快速基准测试。
数据和图书馆：
library(data.table)
library(tidyverse)
library(microbenchmark)
dt.orig = data.table(ID= 1:3,
a = c("Y", "Y", "N"),
b = c("N", "Y", "Y"),
XXa=c(101, 102, 103),
XXb=c(110, 120, 130),
YYYa=c(201, 202, 203),
YYYb=c(210, 220, 230))
第一个 data.table 解决方案（包装在基准函数中）：
dt_1 <- function() {
dt = melt(dt.orig,
id.vars=c("a", "b", "ID"),
measure.vars=patterns("XX|YYY"),
variable.factor=FALSE)
dt = melt(dt,
id.vars=c("ID", "variable", "value"),
value.name="outcome",
variable.name="obs",
variable.factor=FALSE)
dt = dt[substr(variable, nchar(variable), nchar(variable)) == obs]
dt[, variable := substr(variable, 1, nchar(variable)-1)]
dcast(dt, ID + obs + outcome ~ variable)
}
第二个data.table解决方案：
dt_2 <- function() {
# ID-obs-outcome
dt1 = melt(dt.orig[, .(ID, a, b)],
id.vars="ID",
value.name="outcome",
variable.name="obs",
variable.factor=FALSE)
# ID-obs-XX-YYY
dt2 = melt(dt.orig[, !c("a", "b")],
id.vars="ID",
variable.factor=FALSE)
dt2[, obs := substr(variable, nchar(variable), nchar(variable))]
dt2[, variable := substr(variable, 1, nchar(variable)-1)]
dt2 = dcast(dt2, ID + obs ~ variable)
# merge
merge(dt1, dt2, by=c("ID", "obs"))
}
tidyverse LRRR 作为工作答案发布的解决方案：
tidy_1 <- function(){
# flatten cols a,b
outcome <- c(t(select(dt.orig, c(a, b))))
# pivot longer on regex and add outcome list
dt.orig %>%
pivot_longer(-c(ID, a, b),
names_to = c(".value", "obs"),
names_pattern = "(.*)(.)") %>%
mutate(outcome = outcome) %>%
select(-c(a, b))
}
基准：
microbenchmark(dt_1(), dt_2(), tidy_1(), times=20)
#> Unit: milliseconds
#> expr min lq mean median uq max neval cld
#> dt_1() 2.695407 2.716623 4.968294 2.900856 3.101634 43.51289 20 a
#> dt_2() 4.849555 5.027214 6.704733 5.160479 6.297621 18.93398 20 a
#> tidy_1() 13.149104 13.515273 16.439809 13.769746 15.506042 47.13444 20 b
你可以用两行实现：
dt.res <- melt(dt.orig, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
setorder(dt.res, ID)[, obs := unname(c("1" = "a", "2" = "b")[obs])]
输出
> dt.res[]
ID obs outcome XX YYY
1: 1 a Y 101 201
2: 1 b N 110 210
3: 2 a Y 102 202
4: 2 b Y 120 220
5: 3 a N 103 203
6: 3 b Y 130 230
这是上面相同代码的稍微长一点的版本
dt.res <-
melt(
dt.new2,
id.vars = "ID", measure.vars = patterns("^[ab]$", "^XX", "^YYY"),
variable.name = "obs", value.name = c("outcome", "XX", "YYY")
)
setorder(dt.res, ID)[, obs := unname(c("1" = "a", "2" = "b")[obs])]
补充说明
似乎除了 ID 列外，您还有三组列需要同时旋转：没有任何前缀的列（即 a 和 b），前缀为 XX 的那些和前缀为 YYY 的那些。如果在每组中，后缀为a的列总是出现在后缀为b的列之前，那么您可以同时melt这些列组， as data.table v1.9.6 and after 本机支持此类操作。您需要使用 regex.
这就是我们 patterns("^[ab]$", "^XX", "^YYY") 的原因，它捕获我们尝试 melt 的三个列组。 melt操作后，你会得到一个data.table这样的：
ID obs outcome XX YYY
1: 1 1 Y 101 201
2: 2 1 Y 102 202
3: 3 1 N 103 203
4: 1 2 N 110 210
5: 2 2 Y 120 220
6: 3 2 Y 130 230
我们在 obs 中得到 1 和 2 而不是 a 和 b，因为 melt 操作会自动设置第一个每个组内匹配为 "1"，第二个为 "2"，依此类推。稍后我们可以通过指定 "1" = "a" 和 "2" = "b" 来重置此列。但是，您可能知道，如果带有后缀 a 的列出现在带有 b 的列之后，那么我们就不能再使用此映射 c("1" = "a", "2" = "b")。这就是为什么我们必须确保每个列组的顺序正确。
为了更好地说明这个排序问题，请参见下面的代码：
# Assume that your data.table looks like this
> dt.unordered
ID b a XXa YYYb XXb YYYa
1: 1 N Y 101 210 110 201
2: 2 Y Y 102 220 120 202
3: 3 Y N 103 230 130 203
# See the difference now?
> dt.wrong <- melt(dt.unordered, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
> dt.wrong[]
ID obs outcome XX YYY
1: 1 1 N 101 210
2: 2 1 Y 102 220
3: 3 1 Y 103 230
4: 1 2 Y 110 201
5: 2 2 Y 120 202
6: 3 2 N 130 203
因此，如果您无法确保每个组内的顺序，或许可以执行 pre-processing 来修复列顺序。这样也能得到正确的结果
> setcolorder(dt.unordered, sort(names(dt.unordered)))
> dt.fixed <- melt(dt.unordered, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
> dt.fixed[]
ID obs outcome XX YYY
1: 1 1 Y 101 201
2: 2 1 Y 102 202
3: 3 1 N 103 203
4: 1 2 N 110 210
5: 2 2 Y 120 220
6: 3 2 Y 130 230
总而言之，如果您有所有列 pre-ordered，请执行以下操作：
dt.res <- melt(dt.orig, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
setorder(dt.res, ID)[, obs := unname(c("1" = "a", "2" = "b")[obs])]
如果没有，请执行此操作：
setcolorder(dt.orig, sort(names(dt.orig)))
dt.res <- melt(dt.orig, "ID", patterns("^[ab]$", "^XX", "^YYY"), "obs", c("outcome", "XX", "YYY"))
setorder(dt.res, ID)[, obs := unname(c("1" = "a", "2" = "b")[obs])]