Question

我有一个数据框，其中包含表示疾病诊断的字符串变量。我想根据一些规则对诊断进行分类：

rules <- list(
  group1 = c('A012', 'A02', 'C30'),
  group2 = c('B01', 'B02')
)

如果诊断字段包含'A01'，'A02'或'A03'（包括包含这些模式的文本，例如'A0199'），那么案例应该放在第1组中，依此类推。

我的数据如下：

dat <- data.frame(
  ID = seq_len(10),
  diagnosis = c('A012', 'A01', 'B23', 'C43', 'B023', 'A99', 'A023', 'B012', 'B04', 'A07')
)

我使用过的方法如下：

# modify the rules so they work with grep    
rules <- lapply(rules, paste, collapse = '|')

# create a function that classifies an individual diagnosis
group <- function(y) {
      a <- sapply(rules, grepl, x = y)
      a <- names(a)[a]
      return(if (length(a) == 0) NA else a)
    }

# apply the function across the data frame
dat$group <- sapply(dat$diagnosis, group)

这似乎有效，但我的数据集很大，有很多规则，而且速度极慢！

我有更快的方法吗？

Answer 1

这是一个小小的低保真，我确信有更多花哨的dplyr和data.table方法可以做到这一点，但至少它是相当透明的。您必须判断的速度方面，但它都是矢量化的，所以应该相当快。

我所做的是首先构建一些规则向量。它是以A开头，是以B开头，是以C开头，第二个字符是0，有多少个字符，等
然后我使用这些向量通过使用逻辑运算符组合规则向量来构建组向量最后，group向量是利用这些事实构建的，例如TRUE*2 == 2和FALSE*3 == 0。因此，如果诊断符合无组，则将返回0。如果诊断符合多个组，则会有点混乱。

dat <- data.frame(
  ID = seq_len(10),
  diagnosis = c('A012', 'A02', 'B23', 'C43', 'B023', 
                'A99', 'A023', 'B012', 'B04', 'A07'),
  stringsAsFactors=FALSE  

)

dat <- within(dat, {
    A=grepl("^A", diagnosis)
    B=grepl("^B", diagnosis)
    C=grepl("^C", diagnosis)
    z=grepl("^.0+", diagnosis)
    n=nchar(diagnosis)

    gr1=(A & n > 3)
    gr2=(B & z)
    gr3=(C & !z)

    group=(gr1 + gr2*2 + gr3*3)
  }
  )

Answer 2

如果规则的数量不是太大（OP说它只有40个），我们可以运行规则并使用stringi::stri_detect_fixed执行完全匹配（这要快得多）比使用正则表达式

首先，我们将奉承rules

rules_dt <- list(rules = unlist(rules, use.names = FALSE), 
                 grp = rep(seq_len(length(rules)), lengths(rules)))

然后，定义函数

library(stringi)
f <- function(x) dat[stri_detect_fixed(dat$diagnosis, rules_dt$rules[x]), "group"] <<- rules_dt$grp[x]

然后，按规则运行

invisible(lapply(seq_len(length(rules_dt[[1]])), f))
dat
#    ID diagnosis group
# 1   1      A012     1
# 2   2       A02     1
# 3   3       B23    NA
# 4   4       C43    NA
# 5   5      B023     2
# 6   6       A99    NA
# 7   7      A023     1
# 8   8      B012     2
# 9   9       B04    NA
# 10 10       A07    NA

基准测试：在我的笔记本电脑上运行.5MM行和10组10，它运行约4秒

library(stringi)
n <- 10
N <- 5e5

set.seed(123)
rules <- setNames(replicate(n, 
                  stri_rand_strings(n = n, length = 4), simplify = FALSE), 
                  paste0("group", 1:n))

dat <- data.frame(
  ID = 1:N,
  diagnosis = stri_rand_strings(N, 4),
  stringsAsFactors = FALSE
)

system.time({
  rules_dt <- list(rules = unlist(rules, use.names = FALSE), 
                   grp = rep(seq_len(length(rules)), lengths(rules))) 
  invisible(lapply(seq_len(length(rules_dt[[1]])), f))
})

# user  system elapsed 
# 3.27    0.43    3.70

Answer 3

为了完整起见，我还使用grep找到了更好的解决方案，它绕过规则而不是行。我已经为下面的解决方案计时了。 stringi选项是最好的，但替代grep方法比我原来的解决方案要好得多：

# rules and dataset

rules <- list(
  group1 = c('A012', 'A02', 'C30'),
  group2 = c('B01', 'B02'),
  group3 = c('C01', 'D03')
)

D <- 100000
diagnoses <- c('A012', 'A02', 'C30', 'B01', 'B02', 'C01', 'D03', 'X99', 'X100', 'XA99', 'A99', 'D99')

dat <- data.frame(
  ID = seq_len(D),
  diagnosis = sample(diagnoses, D, replace = T),
  stringsAsFactors = F
)

# initial approach

rules2 <- lapply(rules, paste, collapse = '|')

group <- function(y) {
  a <- sapply(rules2, grepl, x = y)
  a <- names(a)[a]
  return(if (length(a) == 0) NA else a)
}

ptm <- proc.time()
dat$group <- sapply(dat$diagnosis, group)
proc.time() - ptm

table(dat$group)

# alternative looping approach (across rules rather than cases)

dat$group <- NULL

ptm <- proc.time()

D <- sapply(rules2, grepl, dat$diagnosis)
dat$group <- ifelse(rowSums(D) == 0, NA, max.col(D))

proc.time() - ptm

table(dat2$group)

# stringi approach

dat$group <- NULL

library(stringi)
rules_dt <- list(rules = unlist(rules, use.names = FALSE), 
                 grp = rep(seq_len(length(rules)), lengths(rules)))

ptm <- proc.time()
lapply(1:length(rules_dt[[1]]), function(x) dat[stri_detect_fixed(dat$diagnosis, rules_dt$rules[x]), "group"] <<- rules_dt$grp[x])
proc.time() - ptm

table(dat$group)

R：对文本变量进行分类

3 个答案: