根据与模式的相似性从列中提取类别信息

Question

假设我有以下数据框：

table<-data.frame(col1=c('4.3 automatic version 1', '3.2 manual version 2', 
                         '2.3 version 1', '9.0 version 6'),
                  col2=c('ite auto version 2', 'ite version 3', '2.5 manual version 2',
                         'vserion auto 5'))

                     col1                 col2
1 4.3 automatic version 1   ite auto version 2
2    3.2 manual version 2        ite version 3
3           2.3 version 1 2.5 manual version 2
4           9.0 version 6       vserion auto 5

我想根据第 1 列和第 2 列的内容添加一个值仅为“自动”或“手动”的列。如果 col1 或 col2 包含诸如“auto”之类的词或“自动”，那么 col3 将是“自动”。如果 col1 或 col2 类似于“手动”，则 col3 将是“手动”，如下所示：

                     col1                 col2      col3
1 4.3 automatic version 1   ite auto version 2 automatic
2    3.2 manual version 2        ite version 3    manual
3           2.3 version 1 2.5 manual version 2    manual
4           9.0 version 6       vserion auto 5 automatic

Answer 1

我喜欢保持灵活性。我也喜欢保留中间数据结构。所以几乎可以肯定还有比这更短、内存效率更高的东西。

请注意，我使用正则表达式进行灵活搜索（基于您使用的词 similarity 和 like）。为了演示效果，我对您的输入数据进行了一些更改。我还添加了一些边缘情况。

另一种方法可能是使用tm 文本挖掘包。这将为您提供比 grep 解决方案更大的灵活性，但代价是一些额外的复杂性。

my.table <-
  data.frame(
    col1 = c(
      '4.3 automatic version 1',
      '3.2 manual version 2',
      '2.3 version 1',
      '9.0 version 6',
      'maybe standard',
      'or neither'
    ),
    col2 = c(
      'ite automated version 2',
      'ite version 3',
      '2.5 manual version 2',
      'vserion auto 5',
      'maybe automatic',
      'for reals'
    )
  )

search.terms <- c("auto|automated|automatic", "manual|standard")
names(search.terms) <- c("automatic", "manual")

term.test <- function(term)  {
  term.pres <- apply(
    my.table,
    MARGIN = 1,
    FUN = function(one.cell) {
      any(grep(pattern = term, x = one.cell))
    }
  )
  return(term.pres)
}

term.presence <- lapply(X = search.terms, term.test)

term.presence <- do.call(cbind.data.frame, term.presence)

names(term.presence) <- names(search.terms)

as.labels <- lapply(names(search.terms), function(one.term) {
  tempcol <- tempflag <- term.presence[, one.term]
  tempcol <- rep('', length(tempflag))
  tempcol[tempflag] <- one.term
  return(tempcol)
})

as.labels <- do.call(cbind.data.frame, as.labels)
names(as.labels) <- search.terms

labels.concat <-
  apply(
    as.labels,
    MARGIN = 1,
    FUN = function(one.row) {
      temp <- unique(sort(one.row))
      temp <- temp[nchar(temp) > 0]
      temp <- paste(temp, sep = ", ", collapse = "; ")
      return(temp)
    }
  )

my.table$col3 <- labels.concat

print(my.table)

给了

                     col1                    col2              col3
1 4.3 automatic version 1 ite automated version 2         automatic
2    3.2 manual version 2           ite version 3            manual
3           2.3 version 1    2.5 manual version 2            manual
4           9.0 version 6          vserion auto 5         automatic
5          maybe standard         maybe automatic automatic; manual
6              or neither               for reals                  
>