Check if element is contained on an unequal element of different length

Viewed 37

Im trying to find if part of a character vector overlaps part of another character vector

x <- c("OCT/NOV/DEC", "JAN/DEC/AUG")
y <- c("JAN/FEB/MAR", "APR/MAY/JUN", "JUL/AUG/SEP")

# Months should be split into separate characters

So I would use:

list_x <- strsplit(x, '/')
list_x

#> [[1]]
#> [1] "OCT" "NOV" "DEC"
#> 
#> [[2]]
#> [1] "JAN" "DEC" "AUG"

list_y <- strsplit(y, '/')
list_y

#> [[1]]
#> [1] "JAN" "FEB" "MAR"
#> 
#> [[2]]
#> [1] "APR" "MAY" "JUN"
#> 
#> [[3]]
#> [1] "JUL" "AUG" "SEP"

As we can see, list_x[[1]] has no elements located in any of list_y, so a FALSE should return;

list_x[[2]] has "JAN" and "AUG", which are located in list_y[[1]] and list_y[[3]], so a TRUE should return

# The response should be 

c(FALSE, TRUE) # for each of x elements

# I tried:

detect <- function(x, y){ 
  mapply(function(x, y) any(x %in% y), strsplit(x, '/'), strsplit(y, '/'))
}

detect(x,y)

# Which gives a warning stating the lengths are not multiple and:
#> [1] FALSE FALSE FALSE

So how can I tell if there are x elements that are also in y elements?

Edit: After Akrun's response, I tried a more complex approach envolving non-equi joins

detect <- function(a,b){
  sapply(str_split(a, '/'), function(x) any(sapply(str_split(b, '/'),
                                                   function(y) any(x %in% y))))
}

a <- tibble(a1 = c("A/B/C", "F/E/G"),
            b1 = c(1,2),
            c1 = c("OCT/NOV/DEC", "JAN/DEC/AUG"))

b <- tibble(a2 = c("A/B/C", "D/E/F", "G/H/I"),
            b2 = c(1,2,3),
            c2 = c("JAN/FEB/MAR", "APR/MAY/JUN", "JUL/AUG/SEP"))

fuzzyjoin::fuzzy_left_join(a, b, by = c("a1" = "a2", 
                             "b1" = "b2",
                             "c1" = "c2"),
                match_fun = list(detect, `==`, detect))

## Wrong Result:
#>  a1       b1 c1          a2       b2 c2         
#>  <chr> <int> <chr>       <chr> <int> <chr>      
#> 1 A/B/C     1 OCT/NOV/DEC NA       NA NA         
#> 2 F/E/G     2 JAN/DEC/AUG D/E/F     2 APR/MAY/JUN

# Row 2: Although a1 and a2 have matching characters and b1 matches b2, c1 and c2 have no matching characters, so the join shouldn't be possible

## Expected:
#>  a1       b1 c1          a2       b2 c2         
#>  <chr> <int> <chr>       <chr> <int> <chr>      
#> 1 A/B/C     1 OCT/NOV/DEC NA       NA NA         
#> 2 F/E/G     2 JAN/DEC/AUG NA       NA NA

Maybe I'm misinterpreting something in this function?

1 Answers

We could use a nested sapply with any

sapply(list_x, function(x) any(sapply(list_y, function(y) any(x %in% y))))
#[1] FALSE  TRUE

For the updated data, if we change the any with all, it would give the expected output

detect <- function(a,b){
   sapply(str_split(a, '/'), function(x) all(sapply(str_split(b, '/'),
                                                    function(y) any(x %in% y))))
 }
 fuzzyjoin::fuzzy_left_join(a, b, by = c("a1" = "a2", 
                              "b1" = "b2",
                              "c1" = "c2"),
                 match_fun = list(detect, `==`, detect))
# A tibble: 2 x 6
#  a1       b1 c1          a2       b2 c2   
#  <chr> <dbl> <chr>       <chr> <dbl> <chr>
#1 A/B/C     1 OCT/NOV/DEC <NA>     NA <NA> 
#2 F/E/G     2 JAN/DEC/AUG <NA>     NA <NA> 
Related