translating string matches to a vector of binary elements

user_7223434 0
Viewed 56

I appreciate your assistance with either suggesting a package or a base R solution to the following problem (Thank you in advance.)

Imagine I have a vector of character elements from a statistical_function (below). If I provide the name of two character elements (e.g., provided = c("high", "aware")), then I want a mechanism to produce the following binary vector for me: desired_vector = c(0,1,1,0,1).

Length: This desired_vector has the same length as the number of elements in the output of the statistical function MINUS the element named intrcpt. Thus, in this case, desired_vector will have 5 elements.

Elements A: For each element in the statistical_function's output that doesn't contain : (e.g., "weekhigh") but does contain one of the provided vector's elements ("high") my desired vector should be 1.

Elements B: For each element in the statistical function's output that does contain : (e.g., "weekhigh:testeraware") and does contain BOTH of the provided vector's elements ("high" & "aware") my desired vector should be 1.

Else all remaining elements in the desired_vector should be 0. Is this possible to achieve in R?

In the below example, 1st element of desired_vector is 0 because intrcpt aside, weekssome doesn't contain either "high" or "aware", 2nd element is 1 because weekshigh has "high", 3rd element is 1 because "testeraware" contains "aware", 4th element is 0 because "weekssome:testeraware" doesn't contain BOTH "high" and "aware", and 5th element is 1 because it does contain BOTH "high" and "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)
tidyverse character r regex string
2 Answers

You can try the code below

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

which gives

[1] 0 1 1 0 1
user_121587570

I am not sure if the approach below is what you are looking for. I wasn't sure if you'd always want to drop the first element. To have some control over what is being dropped, I added the drop argument. It takes either the number of the element(s) to drop, or a string, which with the name of the element to drop. It defaults to drop = "intrcpt", which drops the intercept.

# 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

Created on 2021-08-16 by the reprex package (v2.0.1)

If the intercept is always writtin in the same way intrcpt then we can minimalize the function above and remove the drop argument:

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))
}
user_93493020
Related