在 pivot_longer 之前清理标题

Question

我有一个包含 40 传感器的数据集，这些传感器的名称很奇怪（例如 A_B_Loc_1）。我需要将这些数据转换为长格式来绘制它们。我需要拆分名称，以便知道传感器名称（例如来自A_B_Loc_1, name=AB）和传感器位置（例如来自A_B_Loc_1, location=1）。

require(dplyr)
require(janitor)
require(tidyfast)
require(tidyr)

df<-data.frame(time=c("2021-02-27 22:06:20","2021-02-27 23:06:20"),A_Loc_1=c(500,600),A_Loc_2=c(500,600),A_B_Loc_1=c(500,600),A_B_Loc_2=c(500,600),B_Loc_1=c(500,600),B_3=c(500,600))

大约有 5000 万行，所以很慢：

编辑：哎哟！有些名称没有“Loc”（例如 B_3 是传感器 B，位置 3）。

#旋转它：

df %>% 
   tidyfast::dt_pivot_longer( #tidyfast package uses data.table instead of tidyr, so much faster
     cols = -time,
     names_to = "name",
     values_to = "value"
  ) %>% drop_na()->df

#拆分名称

df %>% 
  separate(name, 
           into = c("sensor", "location"), 
           sep = "(?=[0-9])"
           ) %>% 
  mutate(sensor=janitor::make_clean_names(sensor, case = "big_camel"))

这可以加速吗？ left join 有一个根据传感器名称添加列的查找表？

Answer 1

library(data.table)
setDT(df)

dt <- melt(df, id.vars = c("time"))
dt[, c("name", "location") := tstrsplit(str_replace_all(variable, "_", ""), "Loc")]

dt
#                    time  variable value name location
#  1: 2021-02-27 22:06:20   A_Loc_1   500    A        1
#  2: 2021-02-27 23:06:20   A_Loc_1   600    A        1
#  3: 2021-02-27 22:06:20   A_Loc_2   500    A        2
#  4: 2021-02-27 23:06:20   A_Loc_2   600    A        2
#  5: 2021-02-27 22:06:20 A_B_Loc_1   500   AB        1
#  6: 2021-02-27 23:06:20 A_B_Loc_1   600   AB        1
#  7: 2021-02-27 22:06:20 A_B_Loc_2   500   AB        2
#  8: 2021-02-27 23:06:20 A_B_Loc_2   600   AB        2
#  9: 2021-02-27 22:06:20   B_Loc_1   500    B        1
# 10: 2021-02-27 23:06:20   B_Loc_1   600    B        1

编辑： OP 提到 Loc 并不总是存在，因此我们在最后一个下划线处拆分以获得数字。然后我们在第二步中清理名称以删除下划线和 - 如果存在 - “Loc”

dt <- melt(df, id.vars = c("time"))
dt[, c("name", "location") := tstrsplit(variable, "_(?!.*_)", perl = T)]
dt[, name := str_replace_all(name, "_|Loc", "")]

Answer 2

我们尝试了几种通过正则表达式拆分列的方法。 separate 非常慢，但最快的似乎是 stringr::str_split(..., simplify=TRUE) 来创建新列（用于 tibble）：

require(dplyr)
require(janitor)
require(tidyr)
require(stringr)

df <-
  data.frame(
    time = c("2021-02-27 22:06:20", "2021-02-27 23:06:20"),
    A_Loc_1 = c(500, 600),
    A_Loc_2 = c(500, 600),
    A_B_Loc_1 = c(500, 600),
    A_B_Loc_2 = c(500, 600),
    B_Loc_1 = c(500, 600)
  )

df1 <- df %>%
  # Suggestion from above about cleaning names first?
  clean_names(case = "big_camel") %>%
  tidyfast::dt_pivot_longer(
    cols = -Time,
    names_to = "name",
    values_to = "value") %>%
  drop_na() %>%
  as_tibble

df1[c("sensor", "location")] <-
  str_split(df1$name, "Loc", simplify = TRUE)

这是假设你最大的时间消耗者是分隔列部分！

编辑

至少有四种拆分方式，根据拆分的复杂程度，使用其他方法（例如data.table::tstrsplit）可能会更快，但其中一些需要在所有行之间进行一致的“拆分” ：

library(tidyverse)
library(data.table)


# a sample of 100,000 pivoted rows
n <- 1e5

df  <-  data.frame(condition = c(rep("ABLoc1", times = n),
                                 rep("ABLoc2", times = n),
                                 rep("ACLoc1", times = n),
                                 rep("ACLoc2", times = n),
                                 rep("AALoc4", times = n)))


(speeds <- bench::mark(
  separate = {
    df_sep <- df %>%
      separate(condition,sep = "Loc", into = c("part1", "part2"), remove = FALSE)
  },
  dt = {
    df_dt <- data.table::data.table(df)
    df_dt <-
      df_dt[, c("part1" , "part2") := tstrsplit(condition, split = "Loc", fixed = TRUE)] 
    
    
  },
  stringr = {
    
    df_str <- df
    df_str[c("part1", "part2")] <- str_split(df_str$condition, "Loc", simplify = TRUE)
    
  },
  
  gsub = {
      df_vec <- df
      df_vec$part1 <- gsub("(^.*)Loc.*", "\\1",  df$condition)
      df_vec$part2 <- gsub(".*Loc(.*$)", "\\1",  df$condition)
  },
  iterations = 10,
  check = FALSE
))


#> # A tibble: 4 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 separate      4.63s    5.19s     0.191    3.89GB    4.25 
#> 2 dt          99.44ms 112.32ms     8.95    28.91MB    0.895
#> 3 stringr    296.11ms  306.5ms     3.16    59.53MB    0.632
#> 4 gsub       502.85ms 528.69ms     1.63     7.63MB    0.163


plot(speeds, type = "beeswarm")

每种方法的绘图速度（迭代超过 100,000 行）：

^{由reprex package (v2.0.1) 于 2021-12-08 创建}