主页 / coding / 问题 / 77754517
Accepted
jpsmith
Asked: 2024-01-04 04:32:58 +0800 CST

对多个不整齐的列使用pivot_longer

  • 772

我有这些（杂乱的）数据，其中包含每个患者的药物治疗阶段（ip 或 cp）、药物名称（编码为数字）以及多种药物的剂量信息：

df_have

#   id ip_drug1 ip_dose1 ip_drug2 ip_dose2 cp_drug1 cp_dose1 cp_drug2 cp_dose2
# 1 A1        1      300        3      100        6      500        7      100
# 2 A2        1      300        2      200       11      300       NA       NA
# 3 A3        1      500       NA       NA        9      100        5     1500

我想让这些数据整洁并采用长格式：

df_want

#    id phase drug dose
# 1  A1    ip    1  300
# 2  A1    ip    3  100
# 3  A1    cp    6  500
# 4  A1    cp    7  100
# 5  A2    ip    1  300
# 6  A2    ip    2  200
# 7  A2    cp   11  300
# 8  A2    cp   NA   NA
# 9  A3    ip    1  500
# 10 A3    ip   NA   NA
# 11 A3    cp    9  100
# 12 A3    cp    5 1500

我能够通过 、 和 (和 ) 的组合获得所需tidyr::pivot_longer的dplyr::mutate数据tidyr::pivot_wider框dplyr::select：

library(tidyr)
library(dplyr)

df_have %>% 
  pivot_longer(cols = -id, 
               names_to = c("phase", "type"),
               names_pattern = "(cp|ip)_(drug|dose)") %>%
  mutate(temp = row_number(), 
         .by = c(id, phase, type)) %>%
  pivot_wider(names_from = type, 
              values_from = value) %>%
  select(-temp)

然而，上面的多步代码在我非常大的实际数据上非常慢。我希望在tidyr/内更快地完成此转换dplyr，最好是一步完成pivot_wider。这可能吗？

可重复的df_have数据df_want框：

# have
df_have <- data.frame(id = paste0("A", 1:3), 
                 ip_drug1 = 1,
                 ip_dose1 = c(300, 300, 500),
                 ip_drug2 = c(3, 2, NA),
                 ip_dose2 = c(100, 200, NA),
                 cp_drug1 = c(6, 11, 9),
                 cp_dose1 = c(500, 300, 100),
                 cp_drug2 = c(7, NA, 5),
                 cp_dose2 = c(100, NA, 1500))

# want
df_want <- data.frame(id = rep(paste0("A", 1:3), each = 4),
                      phase = rep(rep(c("ip", "cp"), each = 2), times = 3),
                      drug = c(1, 3, 6, 7, 1, 2, 11, NA, 1, NA, 9, 5),
                      dose = c(300, 100, 500, 100, 300, 200, 300, NA, 500, NA, 100, 1500))

2 个回答

  1. Best Answer

    一步就可以实现pivot_longer。这应该快 4.5 倍左右：

    library(tidyr)

df_have |>
  pivot_longer(-id,
               names_pattern = "(.*?)_(.*?)\\d",
               names_to = c("phase", ".value"))

    .value我认为关键在于论证中的使用names_to。从?pivot_longer：

    “.value”表示列名称的相应组件定义包含单元格值的输出列的名称，并values_to完全覆盖。

    基准

    @ThomasIsCoding 的解决方案甚至更快 (~ 12x)

    one_pivot <- function() {
  df_have |>
    pivot_longer(-id,
                 names_pattern = "(.*?)_(.*?)\\d",
                 names_to = c("phase", ".value"))
}

current <- function() {
  df_have %>% 
    pivot_longer(cols = -id, 
                 names_to = c("phase", "type"),
                 names_pattern = "(cp|ip)_(drug|dose)") %>%
    mutate(temp = row_number(), 
           .by = c(id, phase, type)) %>%
    pivot_wider(names_from = type, 
                values_from = value) %>%
    select(-temp)
}

base <- function() {
  out <- reshape(
    setNames(
      df_have,
      gsub("(\\D+)_(\\D+)", "\\2_\\1", names(df_have))
    ),
    direction = "long",
    idvar = "id",
    varying = -1,
    sep = "_",
    timevar = "phase"
  )
  
  transform(
    `row.names<-`(out[order(out$id), ], NULL),
    phase = sub("\\d+$", "", phase)
  )
}

bench::mark(
  current(),
  one_pivot(),
  base(),
  relative = TRUE,
  check = FALSE
)
  
  expression    min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory               time       gc      
  <bch:expr>  <dbl>  <dbl>     <dbl>     <dbl>    <dbl> <int> <dbl>   <bch:tm> <list> <list>               <list>     <list>  
1 current()   11.4   11.4       1          Inf     1.04    27     2      463ms <NULL> <Rprofmem [141 × 3]> <bench_tm> <tibble>
2 one_pivot()  2.54   2.67      4.43       Inf     1      124     2      480ms <NULL> <Rprofmem [22 × 3]>  <bench_tm> <tibble>
3 base()       1      1        11.7        NaN     1.52   322     3      473ms <NULL> <Rprofmem [0 × 3]>   <bench_tm> <tibble>

    输出

       id    phase  drug  dose
   <chr> <chr> <dbl> <dbl>
 1 A1    ip        1   300
 2 A1    ip        3   100
 3 A1    cp        6   500
 4 A1    cp        7   100
 5 A2    ip        1   300
 6 A2    ip        2   200
 7 A2    cp       11   300
 8 A2    cp       NA    NA
 9 A3    ip        1   500
10 A3    ip       NA    NA
11 A3    cp        9   100
12 A3    cp        5  1500
    • 6

  2. 这是一个基本的 R 解决方案，其中包含一个reshape

    out <- reshape(
    setNames(
        df_have,
        gsub("(\\D+)_(\\D+)", "\\2_\\1", names(df_have))
    ),
    direction = "long",
    idvar = "id",
    varying = -1,
    sep = "_",
    timevar = "phase"
)

df_want <- transform(
    `row.names<-`(out[order(out$id), ], NULL),
    phase = sub("\\d+$", "", phase)
)

    这使

    > df_want
   id phase drug dose
1  A1    ip    1  300
2  A1    ip    3  100
3  A1    cp    6  500
4  A1    cp    7  100
5  A2    ip    1  300
6  A2    ip    2  200
7  A2    cp   11  300
8  A2    cp   NA   NA
9  A3    ip    1  500
10 A3    ip   NA   NA
11 A3    cp    9  100
12 A3    cp    5 1500
    • 5

相关问题