如果子字符串在另一个向量中具有完全匹配，则提取子字符串

Question

Update : the first version of this question was implicitly asking how to extract a substring if it has ANY match in another vector, for which @Colonel Beauvel provided an elegant response:

This does the trick, base R :

 newname = sapply(nametitle, function(u){ bool = sapply(name, function(x) grepl(x, u)) if(any(bool)) name[bool][1] else NA }) newname John Smith, MD PhD Jane Doe, JD "John" "Jane" 

However, I did not realize that I was actually asking for a way to find exact matches until the function kindly contributed did not work for all elements in my vector. Therefore, the following is my revised question.

---

Say I have the following character vector of generic names and their academic degrees:

nametitle <- c("John Smith, MD PhD", "Jane Doe, JD", "John-Paul Jones, MS")

And I have a "look-up" vector of first names:

name <- c("John", "Jane", "Mark", "Steve")

What I want to do is search each element of nametitle , and if part of the element (ie, a substring of each string) is an exact match of an element from name , then in a new vector newname , write that element of nametitle with the corresponding element of name , or if there is no exact match, write the original value from nametitle .

Therefore, what I'd expect the proper function to do is return newname with the three elements below:

[1] "John" [2] "Jane" [3] "John-Paul Jones, MS"

I've attempted the following using the function contributed above:

newname = sapply(nametitle, function(u){
  bool = sapply(name, function(x) grepl(x, u))
  if(any(bool)) name[bool][1] else NA })

Which performs just fine for elements "John Smith, MD Phd" and "Jane Doe, JD" , but not for "John-Paul Jones, MS" -- this element is replaced with "John" in the new vector newname .

There may be a simple change that can be made to the original function contributed by @Colonel Beauvel to resolve this issue, but using nested sapply functions is throwing me through a loop (pun intended?). Thanks.

Answer 1

This does the trick, base R :

newname = sapply(nametitle, function(u){
    bool = sapply(name, function(x) grepl(x, u))
    if(any(bool)) name[bool][1] else NA
})

#>newname
#John Smith, MD PhD       Jane Doe, JD 
#            "John"             "Jane" 

Answer 2

Here's an easy way. First, create a regex pattern based on your name vector:

pattern <- paste0(".*(?<=\\s|^)(", paste(name, collapse = "|"), ")(?=\\s|$).*")
# [1] ".*(?<=\\s|^)(John|Jane|Mark|Steve)(?=\\s|$).*"

If you use this pattern, a single sub command will do the trick:

sub(pattern, "\\1", nametitle, perl = TRUE)
# [1] "John"                "Jane"                "John-Paul Jones, MS"