将字符串匹配转换为二进制元素的向量

Question

感谢您对以下问题的建议包或基本 R 解决方案的帮助（提前致谢。）

假设我有一个来自statistical_function 的字符元素向量（下面）。如果我提供两个字符元素的名称（例如，provided = c("high", "aware")），那么我需要一种机制来为我生成以下二进制向量：desired_vector = c(0,1,1,0,1)。

长度：此desired_vector 的长度与统计函数输出中的元素数减去名为intrcpt 的元素的长度相同。因此，在这种情况下，desired_vector 将具有 5 元素。

元素 A： 对于 statistical_function 的输出中不包含 :（例如 "weekhigh"）但包含 provided 向量元素之一的每个元素("high") 我想要的向量应该是1。

元素 B： 对于统计函数输出中包含 :（例如，"weekhigh:testeraware"）和包含 provided 向量元素（"high" & "aware") 我想要的向量应该是1。

否则desired_vector 中的所有剩余元素都应为0。这可以在 R 中实现吗？

在下面的示例中，desired_vector 的第一个元素是 0，因为除了 intrcpt，weekssome 不包含 "high" 或 "aware"，第二个元素是 1，因为 weekshigh有"high"，第3 个元素是1，因为"testeraware" 包含"aware"，第4 个元素是0，因为"weekssome:testeraware" 不包含"high" 和"aware"，第5 个元素是@987654因为它确实包含"high" 和"aware"。

statistical_function = c("intrcpt","weekssome","weekshigh",            
"testeraware","weekssome:testeraware","weekshigh:testeraware")

# [1] "intrcpt"               "weekssome"             "weekshigh"            
# [4] "testeraware"           "weekssome:testeraware" "weekshigh:testeraware"

provided_vector = c("high", "aware")

desired_vector = c(0, 1, 1, 0, 1)

Answer 1

你可以试试下面的代码

+(
  abs(
    grepl(":", statistical_function) -
      rowSums(
        sapply(provided_vector, grepl, statistical_function)
      )
  ) == 1)[
  statistical_function != "intrcpt"
]

给了

[1] 0 1 1 0 1

Answer 2

我不确定以下方法是否是您正在寻找的方法。我不确定你是否总是想删除第一个元素。为了对要删除的内容进行一些控制，我添加了 drop 参数。它采用要删除的元素的数量或带有要删除的元素名称的字符串。它默认为drop = "intrcpt"，它会丢弃拦截。

# the input vector containing the coefficient names
statistical_function  <- c("intrcpt",
                           "weekssome",
                           "weekshigh",
                           "testeraware",
                           "weekssome:testeraware",
                           "weekshigh:testeraware")

# the input vector containg the search pattern
provided_vector = c("high", "aware")

# a function which matches both
test_input <- function(in_func, in_vec, drop = "intrcpt") {
  
  if(!is.null(drop)) {
    if(is.numeric(drop)) {
      in_func <- in_func[-drop]
    } else if (is.character(drop)) {
      in_func <- in_func[in_func != drop]
    }
  }
  
  inp <- strsplit(in_func, ":")
  
  pat <- paste(in_vec, collapse = "|")
  
  vapply(inp,
         FUN = function(x) all(grepl(pat, x)), 
         FUN.VALUE = numeric(1L))
}

# this does not drop the intercept, so this is not the desired result
test_input(statistical_function, provided_vector)
#> [1] 0 1 1 0 1

# these calls drop the "intrcpt" or the first element
test_input(statistical_function, provided_vector, drop = "intrcpt")
#> [1] 0 1 1 0 1
test_input(statistical_function, provided_vector, drop = 1)
#> [1] 0 1 1 0 1

# test: still working
test_input(statistical_function[-1], provided_vector)
#> [1] 0 1 1 0 1

^{由reprex package (v2.0.1) 于 2021-08-16 创建}

如果拦截总是以相同的方式写入intrcpt，那么我们可以最小化上面的函数并删除drop 参数：

test_input <- function(in_func, in_vec) {
  
  inp <- in_func[in_func != "intrcpt"]
  inp <- strsplit(inp, ":")
  
  pat <- paste(in_vec, collapse = "|")
  
  vapply(inp,
         FUN = function(x) all(grepl(pat, x)), 
         FUN.VALUE = numeric(1L))
}