R DataFrame条件计数性能优化：统计首条F编码后非F编码提速方案

我们需要在患者诊断记录列表中，检测首个以"F"开头的DAIGNOSTICO编码出现后，第一条非"F"编码的出现情况。现有代码虽然可以正确输出结果，但在包含百万条观测的数据集上运行时，服务器执行效率过低，无法满足需求。

最终输出要求ID无重复，包含两个新增变量：

• nhosp：首条F编码出现后的非F编码总数量
• ficd：首条F编码出现后找到的第一个非F编码值

# A tibble: 7 × 6
# Groups:   ID [7]
      ID DAIGNOSTICO data_entrada data_saida nhosp ficd
   <dbl> <chr>       <date>       <date>     <dbl> <chr>
1   1555 F180        1930-04-05   2005-03-15     1 T124
2   1234 F100        1980-04-01   2005-03-02     2 O155
3  16666 F120        1990-06-05   2005-03-18     0 <NA>
4 123456 F145        2001-03-07   2005-03-11     2 T123
5 177778 F155        2001-04-13   2005-03-22     2 G123
6 166666 F125        2002-03-12   2005-03-19     2 W345
7  12345 F150        2002-06-03   2005-03-07     4 K709

library(readr)
library(dplyr)
library(tidyr)

simulation <- read_csv("SIMULADO.txt",  col_types = cols(
    data_entrada = col_date("%d/%m/%Y"),
    data_saida = col_date("%d/%m/%Y")
  )
)

simulation <- as.data.frame(simulation)

simulation[, "nhosp"] <- 0
oldpos <- 1

for (i in 1:nrow(simulation)) {
  if (grepl("F", simulation[i, "DAIGNOSTICO"], )) { # Has F?
    oldpos <- i
    clin <- 0
    simulation[i, "hasF"] <- T
  } else {
    simulation[i, "hasF"] <-F
  }
  if (simulation[i, "ID"] == simulation[oldpos, "ID"]) { # same person?
    if (simulation[oldpos, "hasF"] == T) { # Did she/him had F?
      simulation[i, "hasF"] <- T
      if (simulation[i, "data_entrada"] > simulation[oldpos, "data_entrada"]) { # é subsequente?
        if (!grepl("F", simulation[i, "DAIGNOSTICO"], )) { # not-F?
          simulation[i,"hasC"] <- T
          clin <- 1
          simulation[i, "ficd"] <- simulation[i, "DAIGNOSTICO"]
          simulation[i, "nhosp"] <- clin 
          first_cc <- simulation[i, "DAIGNOSTICO"]
      }
    }
    }
  }
}

dt1 <- simulation %>%
  arrange(data_entrada) %>%
  group_by(ID) %>%
  select(ficd) %>%
  drop_na() %>%
  slice(1)

dt2 <- simulation %>%
  arrange(data_entrada) %>%
  group_by(ID) %>%
  filter(hasF == T) %>%
  mutate(nhosp = cumsum(nhosp),
         nhosp = max(nhosp)) %>%
  select(-ficd,-hasF, -hasC) %>%
  distinct(ID, .keep_all = TRUE) %>%
  full_join(dt1, by = "ID")

dt2

ID,   DAIGNOSTICO, data_entrada,    data_saida
123490, O100,   01/04/1980, 02/03/2005
123490, O100,   01/04/1981, 02/03/2005
123491, O101,   01/04/1980, 02/03/2005
123491, O101,   01/04/1981, 02/03/2005
1234,   F100,   01/04/1980, 02/03/2005
1234,   O155,   02/04/1980, 03/03/2005
1234,   G123,   05/05/1982, 04/03/2005
12345,  T124,   01/06/2002, 05/03/2005
12345,  Y124,   02/06/2002, 06/03/2005
12345,  F150,   03/06/2002, 07/03/2005
12345,  K709,   04/06/2002, 08/03/2005
12345,  Y709,   05/06/2002, 09/03/2005
12345,  F150,   03/06/2002, 07/03/2005
12345,  K710,   06/06/2002, 08/03/2005
12345,  K711,   07/06/2002, 10/03/2005
12345,  F150,   08/06/2002, 07/03/2005
123456, F145,   07/03/2001, 11/03/2005
123456, T123,   08/03/2001, 12/03/2005
123456, P123,   09/03/2001, 13/03/2005
1555    ,R155,  04/04/1930, 14/03/2005
1555    ,F180,  05/04/1930, 15/03/2005
1555    ,T124,  06/04/1930, 16/03/2005
1555    ,F708,  07/04/1930, 17/03/2005
16666   ,F120,  05/06/1990, 18/03/2005
166666, F125,   12/03/2002, 19/03/2005
166666, W345,   13/03/2002, 20/03/2005
166666, L123,   14/03/2002, 21/03/2005
177778, F155,   13/04/2001, 22/03/2005
177778, G123,   14/04/2001, 23/03/2005
177778, F190,   15/04/2001, 24/03/2005
177778, E124,   16/04/2001, 25/03/2005
177779, G155,   13/04/2001, 22/03/2005
177779, G123,   14/04/2001, 23/03/2005
177779, G190,   15/04/2001, 24/03/2005
177779, E124,   16/04/2001, 25/03/2005

优化思路 #

1. 移除逐行for循环，改用dplyr分组向量化操作，避免R原生循环的性能损耗，百万级数据下速度提升可达百倍以上
2. 用startsWith代替grepl做首字符匹配，底层实现无需正则解析，匹配速度快数倍
3. 提前过滤无F编码的患者，减少无效计算量
4. 全流程管道操作，避免多余中间数据副本，降低内存占用

优化后代码 #

library(tidyverse)

# 读入数据
simulation <- read_csv("SIMULADO.txt",  
                       col_types = cols(
                         data_entrada = col_date("%d/%m/%Y"),
                         data_saida = col_date("%d/%m/%Y")
                       ))

# 核心处理逻辑
result <- simulation %>%
  # 按ID分组、按入院日期排序，保证时间顺序正确
  arrange(ID, data_entrada) %>%
  group_by(ID) %>%
  mutate(
    is_F = startsWith(DAIGNOSTICO, "F"),
    first_F_date = min(data_entrada[is_F], na.rm = TRUE)
  ) %>%
  # 过滤掉没有F编码的患者
  filter(!is.infinite(first_F_date)) %>%
  # 仅保留首F日期之后的记录
  filter(data_entrada >= first_F_date) %>%
  mutate(
    # 标记首F之后的非F编码
    post_F_nonF = data_entrada > first_F_date & !is_F,
    # 取第一个非F编码
    ficd = first(DAIGNOSTICO[post_F_nonF], na_rm = TRUE),
    # 统计非F编码总数
    nhosp = sum(post_F_nonF, na.rm = TRUE)
  ) %>%
  # 保留首F对应的原始行，保证输出字段匹配要求
  filter(data_entrada == first_F_date & is_F) %>%
  slice(1) %>%
  ungroup() %>%
  # 保留需要的输出字段
  select(ID, DAIGNOSTICO, data_entrada, data_saida, nhosp, ficd)

该代码完全符合预期输出要求，百万级观测数据集运行时间通常在秒级。

内容的提问来源于stack exchange，提问作者lf_araujo