每个 id 单行到每个 id 多行
Single row per id to multiple row per id
我想根据给定的时间间隔将观察结果从每个 ID 单行扩展到每个 ID 多行：
> dput(df)
structure(list(id = c(123, 456, 789), gender = c(0, 1, 1), yr.start = c(2005,
2010, 2000), yr.last = c(2007, 2012, 2000)), .Names = c("id",
"gender", "yr.start", "yr.last"), class = c("tbl_df", "tbl",
"data.frame"), row.names = c(NA, -3L))
> df
# A tibble: 3 x 4
id gender yr.start yr.last
<dbl> <dbl> <dbl> <dbl>
1 123 0 2005 2007
2 456 1 2010 2012
3 789 1 2000 2000
我希望每年将 id 扩展为一行：
> dput(df_out)
structure(list(id = c(123, 123, 123, 456, 456, 456, 789), gender = c(0,
0, 0, 1, 1, 1, 1), yr = c(2005, 2006, 2007, 2010, 2011, 2012,
2000)), .Names = c("id", "gender", "yr"), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -7L))
> df_out
# A tibble: 7 x 3
id gender yr
<dbl> <dbl> <dbl>
1 123 0 2005
2 123 0 2006
3 123 0 2007
4 456 1 2010
5 456 1 2011
6 456 1 2012
7 789 1 2000
我知道如何melt/reshape，但我不确定如何扩展这些年。
谢谢
这是一个基本的 R 方法。
# expand years to a list
yearList <- mapply(":", df$yr.start, df$yr.last)
现在，使用此列表计算每个 ID 的重复行数（rep 的第二个参数），然后将其附加为向量（从带有 unlist 的列表转换而来）使用 cbind.
# get data.frame
cbind(df[rep(seq_along(df$id), lengths(yearList)), c("id", "gender")], yr=unlist(yearList))
id gender yr
1 123 0 2005
1.1 123 0 2006
1.2 123 0 2007
2 456 1 2010
2.1 456 1 2011
2.2 456 1 2012
3 789 1 2000
这是一个 tidyverse 解决方案
library(tidyverse)
df %>%
group_by(id, gender) %>%
nest() %>%
mutate(data = map(data, ~ seq(.x$yr.start, .x$yr.last))) %>%
unnest() %>%
rename(year = data)
# A tibble: 7 x 3
id gender year
<dbl> <dbl> <int>
1 123 0 2005
2 123 0 2006
3 123 0 2007
4 456 1 2010
5 456 1 2011
6 456 1 2012
7 789 1 2000
您可以 gather 为长格式，然后使用 tidyr.
通过 complete 填充缺失的行
library(dplyr)
library(tidyr)
df %>%
gather(group, yr, starts_with("yr") ) %>%
group_by(id, gender) %>%
complete(yr = full_seq(yr, period = 1) )
您可以使用 select 删除多余的列。
df %>%
gather(group, yr, starts_with("yr") ) %>%
select(-group) %>%
group_by(id, gender) %>%
complete(yr = full_seq(yr, period = 1) )
# A tibble: 8 x 3
# Groups: id, gender [3]
id gender yr
<dbl> <dbl> <dbl>
1 123 0 2005
2 123 0 2006
3 123 0 2007
4 456 1 2010
5 456 1 2011
6 456 1 2012
7 789 1 2000
8 789 1 2000
在 dplyr 中使用 do 的另一种方法，但它比基本 R 方法慢。
df %>%
group_by(id, gender) %>%
do(data.frame(yr=.$yr.start:.$yr.last))
# # A tibble: 7 x 3
# # Groups: id, gender [3]
# id gender yr
# <dbl> <dbl> <int>
# 1 123 0 2005
# 2 123 0 2006
# 3 123 0 2007
# 4 456 1 2010
# 5 456 1 2011
# 6 456 1 2012
# 7 789 1 2000
由于 OP 提到他的生产数据集有超过 100 万行并且他正在对不同的解决方案进行基准测试，因此可能值得尝试 data.table 版本：
library(data.table) # CRAN version 1.10.4 used
data.table(DF)[, .(yr = yr.start:yr.last), by = .(id, gender)]
哪个return
id gender yr
1: 123 0 2005
2: 123 0 2006
3: 123 0 2007
4: 456 1 2010
5: 456 1 2011
6: 456 1 2012
7: 789 1 2000
如果非变化列比 gender 多，则进行连接可能比在分组参数中包含所有这些列更有效 by =:
data.table(DF)[DF[, .(yr = yr.start:yr.last), by = id], on = "id"]
id gender yr.start yr.last yr
1: 123 0 2005 2007 2005
2: 123 0 2005 2007 2006
3: 123 0 2005 2007 2007
4: 456 1 2010 2012 2010
5: 456 1 2010 2012 2011
6: 456 1 2010 2012 2012
7: 789 1 2000 2000 2000
请注意，这两种方法都假定 id 在输入数据中是唯一的。
基准测试
OP 有 that he is surprised that above data.table solution is five times slower than ，显然 OP 的生产数据集超过 100 万行。
此外，该问题吸引了 5 个不同的答案以及额外的建议。因此，值得在处理速度方面比较解决方案。
数据
由于生产数据集不可用，并且问题大小以及数据结构等其他因素对于基准测试很重要，因此创建了样本数据集。
# parameters
n_rows <- 1E2
yr_range <- 10L
start_yr <- seq(2000L, length.out = 10L, by = 1L)
# create sample data set
set.seed(123L)
library(data.table)
DT <- data.table(id = seq_len(n_rows),
gender = sample(0:1, n_rows, replace = TRUE),
yr.start = sample(start_yr, n_rows, replace = TRUE))
DT[, yr.last := yr.start + sample(0:yr_range, n_rows, replace = TRUE)]
DF <- as.data.frame(DT)
str(DT)
Classes ‘data.table’ and 'data.frame': 100 obs. of 4 variables:
$ id : int 1 2 3 4 5 6 7 8 9 10 ...
$ gender : int 0 1 0 1 1 0 1 1 1 0 ...
$ yr.start: int 2005 2003 2004 2009 2004 2008 2009 2006 2004 2001 ...
$ yr.last : int 2007 2013 2010 2014 2008 2017 2013 2009 2005 2002 ...
- attr(*, ".internal.selfref")=<externalptr>
对于第一个 运行，创建了 100 行，开始年份可以在 2000 年到 2009 年之间变化，并且个人 id 可以涵盖的年份跨度在 0 到 10 年之间。因此，结果集应该有大约 100 * (10 + 1) / 2 行。
另外，尽管 生产数据可能有 2 到 10 个不变的列，但只包含一个额外的列 gender。
代码
library(magrittr)
bm <- microbenchmark::microbenchmark(
lmo = {
yearList <- mapply(":", DF$yr.start, DF$yr.last)
res_lmo <- cbind(DF[rep(seq_along(DF$id), lengths(yearList)), c("id", "gender")],
yr=unlist(yearList))
},
hao = {
res_hao <- DF %>%
dplyr::group_by(id, gender) %>%
tidyr::nest() %>%
dplyr::mutate(data = purrr::map(data, ~ seq(.x$yr.start, .x$yr.last))) %>%
tidyr::unnest() %>%
dplyr::rename(yr = data)
},
aosmith = {
res_aosmith <- DF %>%
tidyr::gather(group, yr, dplyr::starts_with("yr") ) %>%
dplyr::select(-group) %>%
dplyr::group_by(id, gender) %>%
tidyr::complete(yr = tidyr::full_seq(yr, period = 1) )
},
jason = {
res_jason <- DF %>%
dplyr::group_by(id, gender) %>%
dplyr::do(data.frame(yr=.$yr.start:.$yr.last))
},
uwe1 = {
res_uwe1 <- DT[, .(yr = yr.start:yr.last), by = .(id, gender)]
},
uwe2 = {
res_uwe2 <- DT[DT[, .(yr = yr.start:yr.last), by = id], on = "id"
][, c("yr.start", "yr.last") := NULL]
},
frank1 = {
res_frank1 <- DT[rep(1:.N, yr.last - yr.start + 1L),
.(id, gender, yr = DT[, unlist(mapply(":", yr.start, yr.last))])]
},
frank2 = {
res_frank2 <- DT[, {
m = mapply(":", yr.start, yr.last); c(.SD[rep(.I, lengths(m))], .(yr = unlist(m)))},
.SDcols=id:gender]
},
times = 3L
)
请注意，对 tidyverse 函数的引用是明确的，以避免由于名称混乱而导致的名称冲突 space。
第一个运行
Unit: microseconds
expr min lq mean median uq max neval
lmo 655.860 692.6740 968.749 729.488 1125.193 1520.899 3
hao 40610.776 41484.1220 41950.184 42357.468 42619.887 42882.307 3
aosmith 319715.984 336006.9255 371176.437 352297.867 396906.664 441515.461 3
jason 77525.784 78197.8795 78697.798 78869.975 79283.804 79697.634 3
uwe1 834.079 870.1375 894.869 906.196 925.264 944.332 3
uwe2 1796.910 1810.8810 1880.482 1824.852 1922.268 2019.684 3
frank1 981.712 1057.4170 1086.680 1133.122 1139.164 1145.205 3
frank2 994.172 1003.6115 1081.016 1013.051 1124.438 1235.825 3
对于给定的 100 行大小的问题，时间清楚地表明 dplyr/tidyr 解决方案比基础 R 或 data.table 解决方案慢很多。
结果基本一致：
all.equal(as.data.table(res_lmo), res_uwe1)
all.equal(res_hao, res_uwe1)
all.equal(res_jason, res_uwe1)
all.equal(res_uwe2, res_uwe1)
all.equal(res_frank1, res_uwe1)
all.equal(res_frank2, res_uwe1)
return TRUE 除了 all.equal(res_aosmith, res_uwe1) 其中 returns
[1] "Incompatible type for column yr: x numeric, y integer"
第二个运行
由于执行时间长，tidyverse 解决方案在对较大问题进行基准测试时被跳过。
修改后的参数
n_rows <- 1E4
yr_range <- 100L
结果集预计包含大约 500'000 行。
Unit: milliseconds
expr min lq mean median uq max neval
lmo 425.026101 447.716671 455.85324 470.40724 471.26681 472.12637 3
uwe1 9.555455 9.796163 10.05562 10.03687 10.30571 10.57455 3
uwe2 18.711805 18.992726 19.40454 19.27365 19.75091 20.22817 3
frank1 22.639031 23.129131 23.58424 23.61923 24.05685 24.49447 3
frank2 13.989016 14.124945 14.47987 14.26088 14.72530 15.18973 3
对于给定的问题大小和结构，data.table 解决方案是最快的，而基础 R 方法要慢一个数量级。最简洁的解决方案uwe1也是最快的，在这里。
请注意，结果取决于数据的结构，尤其是参数 n_rows 和 yr_range 以及不变列的数量。如果这些列的数量超过 gender，时间可能会有所不同。
基准测试结果与 OP 对执行速度的观察相矛盾，需要进一步调查。
我想根据给定的时间间隔将观察结果从每个 ID 单行扩展到每个 ID 多行：
> dput(df)
structure(list(id = c(123, 456, 789), gender = c(0, 1, 1), yr.start = c(2005,
2010, 2000), yr.last = c(2007, 2012, 2000)), .Names = c("id",
"gender", "yr.start", "yr.last"), class = c("tbl_df", "tbl",
"data.frame"), row.names = c(NA, -3L))
> df
# A tibble: 3 x 4
id gender yr.start yr.last
<dbl> <dbl> <dbl> <dbl>
1 123 0 2005 2007
2 456 1 2010 2012
3 789 1 2000 2000
我希望每年将 id 扩展为一行：
> dput(df_out)
structure(list(id = c(123, 123, 123, 456, 456, 456, 789), gender = c(0,
0, 0, 1, 1, 1, 1), yr = c(2005, 2006, 2007, 2010, 2011, 2012,
2000)), .Names = c("id", "gender", "yr"), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -7L))
> df_out
# A tibble: 7 x 3
id gender yr
<dbl> <dbl> <dbl>
1 123 0 2005
2 123 0 2006
3 123 0 2007
4 456 1 2010
5 456 1 2011
6 456 1 2012
7 789 1 2000
我知道如何melt/reshape，但我不确定如何扩展这些年。 谢谢
这是一个基本的 R 方法。
# expand years to a list
yearList <- mapply(":", df$yr.start, df$yr.last)
现在，使用此列表计算每个 ID 的重复行数（rep 的第二个参数），然后将其附加为向量（从带有 unlist 的列表转换而来）使用 cbind.
# get data.frame
cbind(df[rep(seq_along(df$id), lengths(yearList)), c("id", "gender")], yr=unlist(yearList))
id gender yr
1 123 0 2005
1.1 123 0 2006
1.2 123 0 2007
2 456 1 2010
2.1 456 1 2011
2.2 456 1 2012
3 789 1 2000
这是一个 tidyverse 解决方案
library(tidyverse)
df %>%
group_by(id, gender) %>%
nest() %>%
mutate(data = map(data, ~ seq(.x$yr.start, .x$yr.last))) %>%
unnest() %>%
rename(year = data)
# A tibble: 7 x 3
id gender year
<dbl> <dbl> <int>
1 123 0 2005
2 123 0 2006
3 123 0 2007
4 456 1 2010
5 456 1 2011
6 456 1 2012
7 789 1 2000
您可以 gather 为长格式，然后使用 tidyr.
complete 填充缺失的行
library(dplyr)
library(tidyr)
df %>%
gather(group, yr, starts_with("yr") ) %>%
group_by(id, gender) %>%
complete(yr = full_seq(yr, period = 1) )
您可以使用 select 删除多余的列。
df %>%
gather(group, yr, starts_with("yr") ) %>%
select(-group) %>%
group_by(id, gender) %>%
complete(yr = full_seq(yr, period = 1) )
# A tibble: 8 x 3
# Groups: id, gender [3]
id gender yr
<dbl> <dbl> <dbl>
1 123 0 2005
2 123 0 2006
3 123 0 2007
4 456 1 2010
5 456 1 2011
6 456 1 2012
7 789 1 2000
8 789 1 2000
在 dplyr 中使用 do 的另一种方法，但它比基本 R 方法慢。
df %>%
group_by(id, gender) %>%
do(data.frame(yr=.$yr.start:.$yr.last))
# # A tibble: 7 x 3
# # Groups: id, gender [3]
# id gender yr
# <dbl> <dbl> <int>
# 1 123 0 2005
# 2 123 0 2006
# 3 123 0 2007
# 4 456 1 2010
# 5 456 1 2011
# 6 456 1 2012
# 7 789 1 2000
由于 OP 提到他的生产数据集有超过 100 万行并且他正在对不同的解决方案进行基准测试，因此可能值得尝试 data.table 版本：
library(data.table) # CRAN version 1.10.4 used
data.table(DF)[, .(yr = yr.start:yr.last), by = .(id, gender)]
哪个return
id gender yr 1: 123 0 2005 2: 123 0 2006 3: 123 0 2007 4: 456 1 2010 5: 456 1 2011 6: 456 1 2012 7: 789 1 2000
如果非变化列比 gender 多，则进行连接可能比在分组参数中包含所有这些列更有效 by =:
data.table(DF)[DF[, .(yr = yr.start:yr.last), by = id], on = "id"]
id gender yr.start yr.last yr 1: 123 0 2005 2007 2005 2: 123 0 2005 2007 2006 3: 123 0 2005 2007 2007 4: 456 1 2010 2012 2010 5: 456 1 2010 2012 2011 6: 456 1 2010 2012 2012 7: 789 1 2000 2000 2000
请注意，这两种方法都假定 id 在输入数据中是唯一的。
基准测试
OP 有 data.table solution is five times slower than
此外，该问题吸引了 5 个不同的答案以及额外的建议。因此，值得在处理速度方面比较解决方案。
数据
由于生产数据集不可用，并且问题大小以及数据结构等其他因素对于基准测试很重要，因此创建了样本数据集。
# parameters
n_rows <- 1E2
yr_range <- 10L
start_yr <- seq(2000L, length.out = 10L, by = 1L)
# create sample data set
set.seed(123L)
library(data.table)
DT <- data.table(id = seq_len(n_rows),
gender = sample(0:1, n_rows, replace = TRUE),
yr.start = sample(start_yr, n_rows, replace = TRUE))
DT[, yr.last := yr.start + sample(0:yr_range, n_rows, replace = TRUE)]
DF <- as.data.frame(DT)
str(DT)
Classes ‘data.table’ and 'data.frame': 100 obs. of 4 variables: $ id : int 1 2 3 4 5 6 7 8 9 10 ... $ gender : int 0 1 0 1 1 0 1 1 1 0 ... $ yr.start: int 2005 2003 2004 2009 2004 2008 2009 2006 2004 2001 ... $ yr.last : int 2007 2013 2010 2014 2008 2017 2013 2009 2005 2002 ... - attr(*, ".internal.selfref")=<externalptr>
对于第一个 运行，创建了 100 行，开始年份可以在 2000 年到 2009 年之间变化，并且个人 id 可以涵盖的年份跨度在 0 到 10 年之间。因此，结果集应该有大约 100 * (10 + 1) / 2 行。
另外，尽管 gender。
代码
library(magrittr)
bm <- microbenchmark::microbenchmark(
lmo = {
yearList <- mapply(":", DF$yr.start, DF$yr.last)
res_lmo <- cbind(DF[rep(seq_along(DF$id), lengths(yearList)), c("id", "gender")],
yr=unlist(yearList))
},
hao = {
res_hao <- DF %>%
dplyr::group_by(id, gender) %>%
tidyr::nest() %>%
dplyr::mutate(data = purrr::map(data, ~ seq(.x$yr.start, .x$yr.last))) %>%
tidyr::unnest() %>%
dplyr::rename(yr = data)
},
aosmith = {
res_aosmith <- DF %>%
tidyr::gather(group, yr, dplyr::starts_with("yr") ) %>%
dplyr::select(-group) %>%
dplyr::group_by(id, gender) %>%
tidyr::complete(yr = tidyr::full_seq(yr, period = 1) )
},
jason = {
res_jason <- DF %>%
dplyr::group_by(id, gender) %>%
dplyr::do(data.frame(yr=.$yr.start:.$yr.last))
},
uwe1 = {
res_uwe1 <- DT[, .(yr = yr.start:yr.last), by = .(id, gender)]
},
uwe2 = {
res_uwe2 <- DT[DT[, .(yr = yr.start:yr.last), by = id], on = "id"
][, c("yr.start", "yr.last") := NULL]
},
frank1 = {
res_frank1 <- DT[rep(1:.N, yr.last - yr.start + 1L),
.(id, gender, yr = DT[, unlist(mapply(":", yr.start, yr.last))])]
},
frank2 = {
res_frank2 <- DT[, {
m = mapply(":", yr.start, yr.last); c(.SD[rep(.I, lengths(m))], .(yr = unlist(m)))},
.SDcols=id:gender]
},
times = 3L
)
请注意，对 tidyverse 函数的引用是明确的，以避免由于名称混乱而导致的名称冲突 space。
第一个运行
Unit: microseconds expr min lq mean median uq max neval lmo 655.860 692.6740 968.749 729.488 1125.193 1520.899 3 hao 40610.776 41484.1220 41950.184 42357.468 42619.887 42882.307 3 aosmith 319715.984 336006.9255 371176.437 352297.867 396906.664 441515.461 3 jason 77525.784 78197.8795 78697.798 78869.975 79283.804 79697.634 3 uwe1 834.079 870.1375 894.869 906.196 925.264 944.332 3 uwe2 1796.910 1810.8810 1880.482 1824.852 1922.268 2019.684 3 frank1 981.712 1057.4170 1086.680 1133.122 1139.164 1145.205 3 frank2 994.172 1003.6115 1081.016 1013.051 1124.438 1235.825 3
对于给定的 100 行大小的问题，时间清楚地表明 dplyr/tidyr 解决方案比基础 R 或 data.table 解决方案慢很多。
结果基本一致：
all.equal(as.data.table(res_lmo), res_uwe1)
all.equal(res_hao, res_uwe1)
all.equal(res_jason, res_uwe1)
all.equal(res_uwe2, res_uwe1)
all.equal(res_frank1, res_uwe1)
all.equal(res_frank2, res_uwe1)
return TRUE 除了 all.equal(res_aosmith, res_uwe1) 其中 returns
[1] "Incompatible type for column yr: x numeric, y integer"
第二个运行
由于执行时间长，tidyverse 解决方案在对较大问题进行基准测试时被跳过。
修改后的参数
n_rows <- 1E4
yr_range <- 100L
结果集预计包含大约 500'000 行。
Unit: milliseconds
expr min lq mean median uq max neval
lmo 425.026101 447.716671 455.85324 470.40724 471.26681 472.12637 3
uwe1 9.555455 9.796163 10.05562 10.03687 10.30571 10.57455 3
uwe2 18.711805 18.992726 19.40454 19.27365 19.75091 20.22817 3
frank1 22.639031 23.129131 23.58424 23.61923 24.05685 24.49447 3
frank2 13.989016 14.124945 14.47987 14.26088 14.72530 15.18973 3
对于给定的问题大小和结构，data.table 解决方案是最快的，而基础 R 方法要慢一个数量级。最简洁的解决方案uwe1也是最快的，在这里。
请注意，结果取决于数据的结构，尤其是参数 n_rows 和 yr_range 以及不变列的数量。如果这些列的数量超过 gender，时间可能会有所不同。
基准测试结果与 OP 对执行速度的观察相矛盾，需要进一步调查。