提取类别信息，基于相似性图案

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”或“automatic”，则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

我喜欢让事情变得灵活。我也喜欢保持中间数据结构。所以几乎肯定会比这更短，更高效的内存。

请注意，我使用正则表达式的灵活性来搜索（根据你使用的话相似和像）。为了演示效果，我对输入数据进行了一些更改。我还添加了一些边缘情况。

另一种方法可能使用tm文本挖掘软件包。这会给你更多的灵活性，这个解决方案的代价是一些额外的复杂性。

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     
>