Task is to extract identical strings with a constraint on positionality:
a <- "TestStringA"
b <- "TeststringB"
Expected matches: "Test"
, "tring"
Solution:
magical_string_processing <- function(stringA, stringB) {
# split strings into individual characters
split_stringA <- unlist(strsplit(stringA, split = ""))
split_stringB <- unlist(strsplit(stringB, split = ""))
# pad vectors of unequal lengths with NAs
if (length(split_stringA) < length(split_stringB)) {
identical_A <- c(split_stringA, rep(NA,
(length(split_stringB)-length(split_stringA))))
identical_B <- split_stringB
} else {
identical_B <- c(split_stringB,rep(NA,
(length(split_stringA)-length(split_stringB))))
identical_A <- split_stringA
}
# compare padded vectors
compared <- identical_A == identical_B
# remove NAs left from padding
compared <- na.omit(compared)
# use names attribute to preserve information about positions
names(compared) <- seq(1, length(compared))
# split comparison based on TRUE/FALSE switches
list_indices <- split(compared, cumsum(c(0,diff(compared)!=0)))
# define function to replace logicals with positions
pick_indices <- function(vec) {
replaced <- if (sum(vec)!=0) {
# replace TRUEs with positions preserved in names
as.numeric(names(vec)) } else {
# set FALSEs to NULL
NULL}
return(replaced)
}
# apply the function to get a list of valid positions
picker_list <- lapply(list_indices, pick_indices)
# remove NULL matches
picker_list_clean <- Filter(Negate(is.null), picker_list)
# define function to select matching characters from original strings
selector_helper <- function(x, string) string[x]
# apply the helper function to either of the strings
temp_result <- lapply(picker_list_clean, selector_helper, split_stringA)
# collapse the matching characters back into strings
result <- sapply(temp_result, paste, collapse = "")
# can insert result <- trimws(result) if spaces should not be in the output
names(result) <- NULL
return(result)
}
Results:
a <- "TestStringA"
b <- "TeststringB"
magical_string_processing(a,b)
[1] "Test" "tring"
Reverse string order:
magical_string_processing(b,a)
[1] "Test" "tring"
Other examples:
a <- "Match1NOMATCH match2test"
b <- "Match1nomatch match2"
magical_string_processing(a,b)
[1] "Match1" " match2"
a <- "TestStringA1testes eeeee"
b <- "TeststringB2ees eeeee"
magical_string_processing(a,b)
[1] "Test" "tring" "es" "eee"