将多个测量列集合（宽格式）重新塑造成单个列（长格式）

Question

我有一个宽格式的数据框，其中包含在不同日期范围内进行的重复测量。在我的示例中，有三个不同的时期，每个时期都有对应的值。例如，第一次测量（Value1）是在从DateRange1Start到DateRange1End的周期内测量的：

ID DateRange1Start DateRange1End Value1 DateRange2Start DateRange2End Value2 DateRange3Start DateRange3End Value3
1 1/1/90 3/1/90 4.4 4/5/91 6/7/91 6.2 5/5/95 6/6/96 3.3 

我希望将数据重塑成长格式，使得DateRangeXStart和DateRangeXEnd列进行分组。因此，在新表中，原始表中的1行变为3行：

ID DateRangeStart DateRangeEnd Value
1 1/1/90 3/1/90 4.4
1 4/5/91 6/7/91 6.2
1 5/5/95 6/6/96 3.3

我知道使用 reshape2 / melt / recast / tidyr 肯定有一种方法可以做到这一点，但我似乎无法想出如何将多组测量变量映射到单个值列。

- daj

---

作为通用做法，将来您可能希望有更好的命名模式。例如，使用“DateRangeStart1”、“DateRangeEnd1”和“Value1”（换句话说，“VariableMeasurement”）会比将测量值粘在变量名称中的某个地方更容易/更简洁。 - A5C1D2H2I1M1N2O1R2T1

答案必须使用 reshape2/melt/recast/tidyr 吗？（如果不是，这个问题将成为更好、更普遍的重复目标） - smci

Answer 1

reshape(dat, idvar="ID", direction="long", 
             varying=list(Start=c(2,5,8), End=c(3,6,9), Value=c(4,7,10)),
             v.names = c("DateRangeStart", "DateRangeEnd", "Value") )
#-------------
    ID time DateRangeStart DateRangeEnd Value
1.1  1    1          1/1/90        3/1/90    4.4
1.2  1    2          4/5/91        6/7/91    6.2
1.3  1    3          5/5/95        6/6/96    3.3

(根据Josh的建议添加了v.names。)

- IRTFM

---

展示 varying= 参数的威力，点个赞。另外，v.names 参数可以美化那些列名，像这样：v.names = c("DateRangeStart", "DateRangeEnd", "Value")。 - Josh O'Brien

Answer 2

data.table 的 melt 函数可以将数据转换为多列。使用该函数，我们只需执行以下操作：

require(data.table)
melt(setDT(dat), id=1L,
     measure=patterns("Start$", "End$", "^Value"), 
     value.name=c("DateRangeStart", "DateRangeEnd", "Value"))

#    ID variable DateRangeStart DateRangeEnd Value
# 1:  1        1         1/1/90       3/1/90   4.4
# 2:  1        2         4/5/91       6/7/91   6.2
# 3:  1        3         5/5/95       6/6/96   3.3

---

或者，您也可以通过列位置引用三组测量列：

melt(setDT(dat), id = 1L, 
     measure = list(c(2,5,8), c(3,6,9), c(4,7,10)), 
     value.name = c("DateRangeStart", "DateRangeEnd", "Value"))

- Arun

Answer 3

使用 tidyr 包自版本 1.0.0 开始，可以使用函数 pivot_longer() 将多个值/测量列从宽格式转换为长格式。

与先前的 gather() 和 spread() tidyr 策略相比（请参见 @AndrewMacDonald 的回答），这种方法优越在于属性不再丢失（如下例中日期仍然保持日期形式，数字仍然保持数字形式）。

library("tidyr")
library("magrittr")

a <- structure(list(ID = 1L, 
                    DateRange1Start = structure(7305, class = "Date"), 
                    DateRange1End = structure(7307, class = "Date"), 
                    Value1 = 4.4, 
                    DateRange2Start = structure(7793, class = "Date"),
                    DateRange2End = structure(7856, class = "Date"), 
                    Value2 = 6.2, 
                    DateRange3Start = structure(9255, class = "Date"), 
                    DateRange3End = structure(9653, class = "Date"), 
                    Value3 = 3.3),
               row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame"))

pivot_longer()（相应的函数：pivot_wider()）与gather()类似。 然而，它提供了额外的功能，例如多个值列。 如果只有一个值列，则宽数据集的所有列名都将进入一个长列中，并使用names_to指定的名称。 对于多个值列，names_to 可以接收多个新名称。

如果所有列名都遵循特定模式(如Start_1，End_1，Start_2等)，则此过程最简单。 因此，我在第一步中重命名了这些列。

(names(a) <- sub("(\\d)(\\w*)", "\\2_\\1", names(a)))
#>  [1] "ID"               "DateRangeStart_1" "DateRangeEnd_1"  
#>  [4] "Value_1"          "DateRangeStart_2" "DateRangeEnd_2"  
#>  [7] "Value_2"          "DateRangeStart_3" "DateRangeEnd_3"  
#> [10] "Value_3"

pivot_longer(a, 
             cols = -ID, 
             names_to = c(".value", "group"),
             # names_prefix = "DateRange",
             names_sep = "_")
#> # A tibble: 3 x 5
#>      ID group DateRangeEnd DateRangeStart Value
#>   <int> <chr> <date>       <date>         <dbl>
#> 1     1 1     1990-01-03   1990-01-01       4.4
#> 2     1 2     1991-07-06   1991-05-04       6.2
#> 3     1 3     1996-06-06   1995-05-05       3.3

或者，可以使用提供更精细控制的数据透视表来进行重塑（请参见下面的链接）：

spec <- a %>%
    build_longer_spec(cols = -ID) %>%
    dplyr::transmute(.name = .name,
                     group = readr::parse_number(name),
                     .value = stringr::str_extract(name, "Start|End|Value"))

pivot_longer(a, spec = spec)

^{使用 reprex 包 (v0.2.1) 在2019年03月26日创建}

另请参阅：https://tidyr.tidyverse.org/articles/pivot.html

- hplieninger

---

这实际上是对一个稍微不同的问题的答案，即如何避免使用整洁方法丢失属性。最初被接受的答案（使用stats::reshape）从未出现过这个问题。而原始问题显然也没有日期类变量。重塑函数保留了因子水平和日期类。 - IRTFM

我完全同意你的 stats::reshape() 解决方案（+1），同样可以很好地完成任务。 - hplieninger

正则表达式可以简化为 names(a) <- sub("(\\d)(\\w*)", "\\2_\\1", names(a))。 - cimentadaj

Answer 4

以下是使用 tidyr 解决该问题的方法。 这是一个有趣的用例，可以使用它的函数extract_numeric()来从列名中提取分组信息。

library(dplyr)
library(tidyr)

a <- read.table(textConnection("
ID DateRange1Start DateRange1End Value1 DateRange2Start DateRange2End Value2 DateRange3Start DateRange3End Value3
1 1/1/90 3/1/90 4.4 4/5/91 6/7/91 6.2 5/5/95 6/6/96 3.3 
"),header=TRUE)

a %>%
  gather(variable,value,-ID) %>%
  mutate(group = extract_numeric(variable)) %>%
  mutate(variable =  gsub("\\d","",x = variable)) %>%
  spread(variable,value)

  ID group DateRangeEnd DateRangeStart Value
1  1     1       3/1/90         1/1/90   4.4
2  1     2       6/7/91         4/5/91   6.2
3  1     3       6/6/96         5/5/95   3.3

- AndrewMacDonald

Answer 5

两个附加选项（使用具有多行的示例数据框更好地展示代码工作）：

1）使用基本R：

l <- lapply(split.default(d[-1], cumsum(grepl('Start$', names(d)[-1]))),
            setNames, c('DateRangeStart','DateRangeEnd','Value'))
data.frame(ID = d[,1], do.call(rbind, l), row.names = NULL)

这句话的意思是：“得到的结果是：”。

  ID DateRangeStart DateRangeEnd Value
1  1         1/1/90       3/1/90   4.4
2  2         1/2/90       3/2/90   6.1
3  1         4/5/91       6/7/91   6.2
4  2         4/6/91       6/8/91   3.2
5  1         5/5/95       6/6/96   3.3
6  2         5/5/97       6/6/98   1.3

使用 tidyverse:

library(dplyr)
library(purrr)

split.default(d[-1], cumsum(grepl('Start$', names(d)[-1]))) %>%
  map_dfr(~set_names(., c('DateRangeStart','DateRangeEnd','Value'))) %>% 
  bind_cols(ID = rep(d$ID, nrow(.)/nrow(d)), .)

3）使用sjmisc包：

library(sjmisc)
to_long(d, keys = 'group',
        values = c('DateRangeStart','DateRangeEnd','Value'), 
        c('DateRange1Start','DateRange2Start','DateRange3Start'),
        c('DateRange1End','DateRange2End','DateRange3End'),
        c('Value1','Value2','Value3'))[,-2]

---

如果您还想要一个组/时间列，您可以根据上述方法进行调整：

1) 使用基本 R:

l <- lapply(split.default(d[-1], cumsum(grepl('Start$', names(d)[-1]))),
            setNames, c('DateRangeStart','DateRangeEnd','Value'))
data.frame(ID = d[,1],
           group = rep(seq_along(l), each = nrow(d)),
           do.call(rbind, l), row.names = NULL)

这句话的翻译是：“这给出了：”。

  ID group DateRangeStart DateRangeEnd Value
1  1     1         1/1/90       3/1/90   4.4
2  2     1         1/2/90       3/2/90   6.1
3  1     2         4/5/91       6/7/91   6.2
4  2     2         4/6/91       6/8/91   3.2
5  1     3         5/5/95       6/6/96   3.3
6  2     3         5/5/97       6/6/98   1.3

2）使用 tidyverse：

split.default(d[-1], cumsum(grepl('Start$', names(d)[-1]))) %>%
  map_dfr(~set_names(., c('DateRangeStart','DateRangeEnd','Value'))) %>% 
  bind_cols(ID = rep(d$ID, nrow(.)/nrow(d)),
            group = rep(1:(nrow(.)/nrow(d)), each = nrow(d)), .)

3）使用sjmisc包：

library(sjmisc)
to_long(d, keys = 'group', recode.key = TRUE,
        values = c('DateRangeStart','DateRangeEnd','Value'), 
        c('DateRange1Start','DateRange2Start','DateRange3Start'),
        c('DateRange1End','DateRange2End','DateRange3End'),
        c('Value1','Value2','Value3'))

翻译：使用的数据：

d <- read.table(text = "ID DateRange1Start DateRange1End Value1 DateRange2Start DateRange2End Value2 DateRange3Start DateRange3End Value3
1 1/1/90 3/1/90 4.4 4/5/91 6/7/91 6.2 5/5/95 6/6/96 3.3
2 1/2/90 3/2/90 6.1 4/6/91 6/8/91 3.2 5/5/97 6/6/98 1.3", header = TRUE, stringsAsFactors = FALSE)

- Jaap

Answer 6

使用回收功能：

data.frame(ID = d[, 1],
           DateRangeStart = unlist(d[, -1][, c(TRUE, FALSE, FALSE)]),
           DateRangeEnd  = unlist(d[, -1][, c(FALSE, TRUE, FALSE)]),
           Value =  unlist(d[, -1][, c(FALSE, FALSE, TRUE)]))

- zx8754

Answer 7

在 tidyverse 中，另一种解决方案是利用 names_pattern 参数来使用 tidyr::pivot_longer()。

names_pattern 使用与 extract() 相同的规范，包含匹配组 (()) 的正则表达式。

作为一个不需要预处理字符串的单个命令，这可能比 @hplieninger 在此处给出的答案更好。

library(tidyverse)


# ...
# Code to generate dataset 'ds'.
# ...


ds %>% pivot_longer(
  # Target only those columns names with a numeric index; possibly suffixed by "Start"
  # or "End".
  cols = matches("^(.*)(\\d+)(Start|End)?$"),
  # Break each name into its prefix, index, and suffix.
  names_pattern = "^(.*)(\\d+)(Start|End)?$",
  # Pivot by index and reassemble the other components.
  names_to = c(".value", "group_id", ".value")
)

您可以进一步将代码简化成一行，如下所示。

pivot_longer(ds, !ID, names_pattern = "^(.*)(\\d+)(Start|End)?$", names_to = c(".value", NA, ".value"))

结果

在你的示例数据集中，!ID 只是将每一列（但不包括 ID）作为分组变量；而 NA 则忽略了组索引 (group_id)，就像你的输出示例中一样。

假设有一个类似于你的示例数据集的 ds

ds <- structure(
  list(
    ID = 1L,
    DateRange1Start = structure(7305, class = "Date"), 
    DateRange1End = structure(7307, class = "Date"),
    Value1 = 4.4, 
    DateRange2Start = structure(7793, class = "Date"),
    DateRange2End = structure(7856, class = "Date"), 
    Value2 = 6.2,
    DateRange3Start = structure(9255, class = "Date"), 
    DateRange3End = structure(9653, class = "Date"),
    Value3 = 3.3
  ),
  row.names = c(NA, -1L),
  class = c("tbl_df", "tbl", "data.frame")
)

这个解决方案应该产生以下结果。

# A tibble: 3 x 5
     ID group_id DateRangeStart DateRangeEnd Value
  <int> <chr>    <date>         <date>       <dbl>
1     1 1        1990-01-01     1990-01-03     4.4
2     1 2        1991-05-04     1991-07-06     6.2
3     1 3        1995-05-05     1996-06-06     3.3

或者，为了简化命令：

# A tibble: 3 x 4
     ID DateRangeStart DateRangeEnd Value
  <int> <date>         <date>       <dbl>
1     1 1990-01-01     1990-01-03     4.4
2     1 1991-05-04     1991-07-06     6.2
3     1 1995-05-05     1996-06-06     3.3

- Greg

---

一个更简单的形式：pivot_longer(a, cols = -ID, names_to = c('.value', '.value'), names_pattern = "(.+)\\d(.*)") - sammywemmy

Answer 8

你不需要任何花哨的东西；基本的R函数就可以。

a <- read.table(textConnection("
ID DateRange1Start DateRange1End Value1 DateRange2Start DateRange2End Value2 DateRange3Start DateRange3End Value3
1 1/1/90 3/1/90 4.4 4/5/91 6/7/91 6.2 5/5/95 6/6/96 3.3 
"),header=TRUE)
b1 <- a[,c(1:4)]; b2 <- a[,c(1,5:7)]; b3 <- a[,c(1,8:10)]
colnames(b1) <- colnames(b2) <- colnames(b3) <- c("ID","DateRangeStart","DateRangeEnd","Value")
b <- rbind(b1,b2,b3)

- Blue Magister