r - 将函数分别应用于列的每个元素

Question

让我们假设以下是我的数据表 data

data <- setDT(structure(list(col1 = c(1, 2, 3, 4, 5), col2 = c(53, 45, 54, 
97, 23), col3 = c("aa aa aa aa ab ad af ae ar", "bb bb bb bb bt by bu bi bo", 
"cc cc cc cc cd cy ch cn cd", "dd dd dd dd dt dy dj dk da", "ee ee ee ee et eh es er eg"
), col4 = c("aa bb ff ff","aa ff vv rr","dd dd rr gg",
"yy yy rr rr","uu uu uu ee")), .Names = c("col1", "col2", "col3", "col4"), 
row.names = c(NA, -5L), class = "data.frame"))

col1     col2    col3                            col4
1        53      aa aa aa aa ab ad af ae ar      aa bb ff ff
2        45      bb bb bb bb bt by bu bi bo      aa ff vv rr
3        54      cc cc cc cc cd cy ch cn cd      dd dd rr gg
4        97      dd dd dd dd dt dy dj dk da      yy yy rr rr
5        23      ee ee ee ee et eh es er eg      uu uu uu ee

col3 有单词字符串，我需要确定 col3 中最常出现的 word 是否出现在 col4 中。所以输出将如下所示:

col1     col2    col3                            col4          most_freq_word_in_cool3       out_col
1        53      aa aa aa aa ab ad af ae ar      aa bb ff ff             aa                      1  
2        45      bb bb bb bb bt by bu bi bo      aa ff vv rr             bb                      0
3        54      cc cc cc cc cd cy ch cn cd      dd dd rr gg             cc                      0  
4        97      dd dd dd dd dt dy dj dk da      yy yy rr rr             dd                      0 
5        23      ee ee ee ee et eh es er eg      uu uu uu ee             ee                       1

我尝试了以下解决方案

    m_fre_word1 <- function(x) { string <- as.character(unlist(strsplit(x, " ")))
                                freq <- sort(table(string), decreasing = T)
                                wr <-names(freq)[1]
                                return(wr) }

    data <- data[ , most_freq_word_in_cool3:= apply(data[ , .(col3)], 1, m_fre_word1)]
    data <- data[ , out_col:= as.numeric(grepl(m_fre_word1(col3), col4))]

这个方案没什么问题，但是真的很慢。我的数据表很大。我不能使用这种方式，所以我正在寻找更快的替代方法。有人可以建议一个更快的替代方案。

谢谢，

Answer 1

这是一个尝试。我建议拆分列并在长格式上运行，而不是在每一行上运行整个过程。

我在偷 Mode来自 here 的功能定义如下

Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
} 

现在使用最新的 data.table我们可以做的版本

library(data.table) # v 1.9.6+
temp <- setDT(data6)[, tstrsplit(col3, " ", fixed = TRUE)]
data6[, res := melt(temp[, indx := .I], id = "indx")[, Mode(value), by = indx]$V1]
data6

#    col1 col2                       col3        col4 res
# 1:    1   53 aa aa aa aa ab ad af ae ar aa bb ff ff  aa
# 2:    2   45 bb bb bb bb bt by bu bi bo aa ff vv rr  bb
# 3:    3   54 cc cc cc cc cd cy ch cn cd dd dd rr gg  cc
# 4:    4   97 dd dd dd dd dt dy dj dk da yy yy rr rr  dd
# 5:    5   23 ee ee ee ee et eh es er eg uu uu uu ee  ee

---

第二步可以通过eitehr轻松实现

data6[, out := +grepl(res, col4, fixed = TRUE), by = res]

OR(不确定哪个更快)

library(stringi)
data6[stri_detect_fixed(col4, res), out := 1L]

---

附带说明一下，使用引用语义时，无需复制整个数据集并使用 <- 重新分配它。 ，事实上，这就是引用语义的全部意义所在。请阅读this .