Question

我有一个包含2列的data.frame。其中一列用于存储每个产品的颜色（按行）。我也有一份颜色清单见下面的例子：

df <- data.frame(Product = c("a","b","c"), 
           Color = c("black-white-silver-red","black-white-red","black-white"))
colorNames <- list('black','red','silver')

我正在尝试根据颜色列表向data.frame添加新列。该列的目的是返回0或1，具体取决于颜色是否在产品中。理想情况下，输出看起来像这样：

    Product                  Color   black   red   silver    
1        a black-white-silver-red        1     1        1
2        b        black-white-red        1     1        0
3        c            black-white        1     0        0

我曾尝试将regexpr功能与lapply结合使用。以下代码不起作用：

lapply(colorsNames, function(color){
  transform(df, df[[color]] = as.integer(regexpr(color,df$Color)>0) )
 })

然而，这个工作正常，但我无法将其应用于颜色矢量：

transform(df, black = as.integer(regexpr('black',df$Color)>0) )

如果soemone知道如何将最后一个代码应用于颜色矢量，我将非常感激。提前谢谢。

致以最诚挚的问候，

Answer 1

这是使用stringi包的快速解决方案。目前返回可能被二值化的计数。当然有更聪明的方法来实现这一点，但我认为作为一种初步方法，这就是你所需要的。

如果您的数据集非常大，我建议您使用data.table代替data.frame。此外，您可以考虑使用text2vec包（或其他类似的包）来创建计数，方法是将Color作为文档并在此列上应用文本挖掘。但是，我想，在你的情况下，这将是超调。否则，请告诉我，我可以提供替代解决方案。

check_occurrence <- function(df, check_col, patterns) {
 occurrence <-  sapply(patterns, function(x) {
    stri_count_regex(df[,check_col], x) #maybe stri_count_fixed suffices (would be faster)
  })
 colnames(occurrence) <- patterns
 cbind(df, occurrence)  
}

check_occurrence(df = df, check_col = 2, patterns = colorNames)
#   Product                  Color black red silver
# 1       a black-white-silver-red     1   1      1
# 2       b        black-white-red     1   1      0
# 3       c            black-white     1   0      0

#to binarize results do something like
#df[df > 1] <- 1

Answer 2

感谢Manuel，这是我的最终代码（如果有些人有同样的问题）。

    check.colorsOccurrence <- function(list,colorsList){

  if(is.data.frame(list)){  checkedColors <- sapply(colorsList, function(color){
       ifelse(regexpr(color, list$Color) < 0,0,1)
    })
    colnames(checkedColors) <- colorsList
cbind(list,checkedColors)
 }
    else  lapply(list, function(listElmt){
    if(!is.data.frame(listElmt)) check.colorsOccurrence(listElmt, colorsList)
    else {  checkedColors <- sapply(colorsList, function(color){
  ifelse(regexpr(color, listElmt$Color) < 0,0,1)
  })
  colnames(checkedColors) <- colorsList
  cbind(listElmt,checkedColors)
   }
 })
}

使用apply和regexpr将多个列添加到数据框

2 个答案: