Início / coding / Perguntas / 77754517
Accepted
jpsmith
Asked: 2024-01-04 04:32:58 +0800 CST

Usando pivot_longer para múltiplas colunas desarrumadas

  • 772

Eu tenho estes dados (desorganizados) contendo a fase do regime medicamentoso de cada paciente (ip ou cp), o nome do medicamento (codificado como um número) e informações sobre a dose para vários medicamentos:

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

Gostaria de deixar esses dados organizados e em formato longo:

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

Consegui obter o quadro de dados desejado com uma combinação de tidyr::pivot_longer,, dplyr::mutatee tidyr::pivot_wider(e 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)

No entanto, o código de várias etapas acima é muito lento em meus dados reais muito grandes. Eu gostaria de realizar essa transformação mais rapidamente em tidyr/ dplyr, de preferência em uma única pivot_wideretapa. Isso é possível?

Quadros reproduzíveis df_havee df_wantde dados:

# 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 respostas

  1. Best Answer

    É possível em uma única pivot_longeretapa. Isso deve ser cerca de 4,5x mais rápido:

    library(tidyr)

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

    Acho que a chave é o uso de .valueno names_toargumento. De ?pivot_longer:

    ".value" indica que o componente correspondente do nome da coluna define o nome da coluna de saída que contém os valores das células, substituindo values_tototalmente.

    Referência

    A solução de @ThomasIsCoding é ainda mais rápida (~ 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>

    Saída

       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. Aqui está uma solução base R com um únicoreshape

    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)
)

    que dá

    > 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

relate perguntas