R - Найти пересечение общих элементов в двух символьных строках

Я ищу самый быстрый способ подсчета общих элементов в двух символьных строках.

Элементы в строках разделяются символом |.

Макетные данные:

library(data.table)
dt <- data.table(input1 = c("A|B", "C|D|", "R|S|T", "A|B"),
  input2 = c("A|B|C|D|E|F", "C|D|E|F|G", "R|S|T", "X|Y|Z"))

Подсчитайте общие элементы в символьных строках и создайте dt$outcome.

dt <- transform(dt, var1 = I(strsplit(as.character(input1), "\\|")))
dt <- transform(dt, var2 = I(strsplit(as.character(input2), "\\|")))
dt <- transform(dt, outcome = mapply(function(x, y) sum(x%in%y),
   var1, var2))

Результат:

> dt
 input1 input2 var1 var2 outcome
1: A|B A|B|C|D|E|F A,B A,B,C,D,E,F 2
2: C|D| C|D|E|F|G C,D C,D,E,F,G 2
3: R|S|T R|S|T R,S,T R,S,T 3
4: A|B X|Y|Z A,B X,Y,Z 0

Этот пример отлично работает, но реальные данные содержат тысячи элементов input1и input2содержат более 200 000 строк. Таким образом, текущий код работает в течение нескольких дней и не может быть запущен в производство.

Как мы можем ускорить это?

Столбцы dt$var1и dt$var2не являются обязательными выводами и могут быть опущены.

Решение проблемы

dt[, outcome:= lengths(str_extract_all(input2, sub('[|]$', '',input1)))][]
 input1 input2 outcome
1: A|B A|B|C|D|E|F 2
2: C|D| C|D|E|F|G 2
3: R|S|T R|S|T 3
4: A|B X|Y|Z 0

Вы можете ускорить процесс, написав код на C++, C или Fortran. Давайте посмотрим, как будет выглядеть код C++:

Rcpp::cppFunction('
 std::vector<int> count_intersect(std::vector<std::string> vec1,
 std::vector<std::string> vec2, char split){
 auto string_split = [=](std::string x) {
 std::vector<std::string> vec;
 std::string sub_string;
 for(auto i: x){
 if(i == split) {
 vec.push_back(sub_string);
 sub_string = "";
 }
 else sub_string+=i;
 }
 if(sub_string.size() > 0)vec.push_back(sub_string);
 return vec;
 };
 
 auto count = [=](std::string input1, std::string input2){
 std::vector<std::string> in1 = string_split(input1);
 std::vector<std::string> in2 = string_split(input2);
 int total = 0;
 for (auto i: in1) 
 if(std::find(in2.begin(), in2.end(), i)!= in2.end()) total += 1;
 return total;
 };
 std::size_t len1 = vec1.size();
 std::vector<int> result(len1);
 for (std::size_t i = 0; i<len1; i++)
 result[i] = count(vec1[i], vec2[i]);
 return result;
}')
 dt[, outcome:=count_intersect(input1, input2, "|")][]
 input1 input2 outcome
 1: A|B A|B|C|D|E|F 2
 2: C|D| C|D|E|F|G 2
 3: R|S|T R|S|T 3
 4: A|B X|Y|Z 0
 

Выполнение BenchMark: с действительно большими данными, т.е. 200 000 строк:

bigdt <- mosaic::sample(dt, 200000, TRUE)[,1:2]
inputs <- c("input1", "input2")
vars <- c("var1", "var2")
bench::mark(OP = {
 bigdt <- transform(bigdt, var1 = I(strsplit(as.character(input1), "\\|")))
 bigdt <- transform(bigdt, var2 = I(strsplit(as.character(input2), "\\|")))
 bigdt <- transform(bigdt, outcome = mapply(function(x, y) sum(x%in%y), var1, var2))
},
r2evans = {
 bigdt[, (vars):= lapply(.SD, strsplit, "|", fixed = TRUE),.SDcols = inputs
 ][, outcome:= mapply(function(x, y) sum(x %in% y), var1, var2)]
},
r2evans2 = {bigdt[, outcome:= mapply(function(x, y) sum(x %in% y), 
  strsplit(input1, "|", fixed = TRUE), 
  strsplit(input2, "|", fixed = TRUE)) ]},
onyambu = {
 bigdt[, outcome:= lengths(stringr::str_extract_all(input2, sub('[|]$', '',input1)))]
},
onyambuCpp = bigdt[, outcome:=count_intersect(input1, input2, "|")],
 relative = TRUE
)
 A tibble: 5 x 13
 expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc total_time result  memory time gc 
 <bch:expr> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <bch:tm> <list>  <list> <list> <list> 
1 OP 12.4 12.1 1 30.9 Inf 1 6 1.66s <data.table [200,000 x 5]> <Rprofmem> <bench_tm> <tibble>
2 r2evans 4.77 4.66 2.60 5.72 Inf 1 3 641.39ms <data.table [200,000 x 5]> <Rprofmem> <bench_tm> <tibble>
3 r2evans2 6.08 5.94 2.04 5.70 Inf 1 5 817.4ms <data.table [200,000 x 5]> <Rprofmem> <bench_tm> <tibble>
4 onyambu 7.36 7.20 1.68 2.47 NaN 1 0 990.19ms <data.table [200,000 x 5]> <Rprofmem> <bench_tm> <tibble>
5 onyambuCpp 1 1 12.1 1 NaN 4 0 549.54ms <data.table [200,000 x 5]> <Rprofmem> <bench_tm> <tibble>

Обратите внимание, что единица является относительной, а CPP как минимум в 4* быстрее, чем следующий метод.