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

时间:2017-06-06 22:54:28

标签: r dataframe

假设我有以下数据框:

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

我想添加一个只有&#39;自动&#39;的值的列。或者&#39;手册&#39;,基于第1列和第2列的内容。如果col1 col2包含某些字词,例如&#39; auto&#39;或者&#39;自动&#39;然后col3将自动&#39;。如果col1 col2就像&#39;手册&#39;然后col3将是&#39;手动&#39;,像这样:

                     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

1 个答案:

答案 0 :(得分:1)

我喜欢保持灵活性。我也想保留中间数据结构。所以几乎肯定会有更短的内存效率。

请注意,我正在使用正则表达式进行灵活搜索(根据您使用的词语相似性喜欢)。为了演示效果,我对输入数据进行了一些更改。我还添加了一些边缘情况。

替代方法可能使用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                  
>