高效地匹配一个向量中的所有值与另一个向量中的值。

huangapple go评论66阅读模式
英文:

Efficiently match all values of a vector in another vector

问题

我正在寻找一种高效的方法,可以匹配向量x中的所有值,而不仅仅是第一个位置,就像match()返回的那样。实际上,我想要的是pmatch()的默认行为,但不进行部分匹配:

x <- c(3L, 1L, 2L, 3L, 3L, 2L)
y <- c(3L, 3L, 3L, 3L, 1L, 3L)

期望的输出:

pmatch(x, y)  
[1]  1  5 NA  2  3 NA

一种方法是使用ave(),但随着组数的增加,这会变得很慢,并且非常占用内存:

ave(x, x, FUN = \(v) which(y == v[1])[1:length(v)])
[1]  1  5 NA  2  3 NA

是否有人能推荐一种在最好的情况下(但不是必须的)使用基本R来实现这一目标的高效方法?

用于基准测试的较大数据集:

set.seed(5)
x <- sample(5e3, 1e5, replace = TRUE)
y <- sample(x, replace = TRUE)
英文:

I'm looking to find an efficient method of matching all values of vector x in vector y rather than just the first position, as is returned by match(). What I'm after essentially is the default behavior of pmatch() but without partial matching:

x &lt;- c(3L, 1L, 2L, 3L, 3L, 2L)
y &lt;- c(3L, 3L, 3L, 3L, 1L, 3L)

Expected output:

pmatch(x, y)  
[1]  1  5 NA  2  3 NA

One way is to use ave() however this becomes slow and very memory inefficient as the number of groups increases:

ave(x, x, FUN = \(v) which(y == v[1])[1:length(v)])
[1]  1  5 NA  2  3 NA

Can anyone recommend an efficient way to achieve this in preferably (but not mandatory) base R?

Larger dataset for benchmarking:

set.seed(5)
x &lt;- sample(5e3, 1e5, replace = TRUE)
y &lt;- sample(x, replace = TRUE)

答案1

得分: 9

在这个代码部分中,你尝试了不同的方法来处理两个向量的匹配和索引问题。以下是你提到的几个部分的翻译:

  1. base 中使用 split 进行变体。
x <- c(3L, 1L, 2L, 3L, 3L, 2L)
y <- c(3L, 3L, 3L, 3L, 1L, 3L)

a <- split(seq_along(x), x)
b <- split(seq_along(y), y)[names(a)]
b[lengths(b) == 0] <- NA
b <- unlist(Map(`length<-`, b, lengths(a)), FALSE, FALSE)
`[<-`(b, unlist(a, FALSE, FALSE), b)
#[1]  1  5 NA  2  3 NA
  1. 你尝试用 RCPP 版本来优化匹配。
Rcpp::sourceCpp(code="
#include <Rcpp.h>
#include <unordered_map>
#include <queue>

using namespace Rcpp;
// [[Rcpp::export]]
IntegerVector pm(const std::vector<int>& a, const std::vector<int>& b) {
  IntegerVector idx(no_init(a.size()));
  std::unordered_map<int, std::queue<int> > lut;
  for(int i = 0; i < b.size(); ++i) lut[b[i]].push(i);
  for(int i = 0; i < idx.size(); ++i) {
    auto search = lut.find(a[i]);
    if(search != lut.end() && search->second.size() > 0) {
      idx[i] = search->second.front() + 1;
      search->second.pop();
    } else {idx[i] = NA_INTEGER;}
  }
  return idx;
}
)")
pm(x, y)
#[1]  1  5 NA  2  3 NA
  1. 优化的 RCPP 版本。
Rcpp::sourceCpp(code="
#include <Rcpp.h>
#include <vector>
#include <array>
#include <queue>
#include <algorithm>

using namespace Rcpp;
// [[Rcpp::export]]
IntegerVector pm2(const std::vector<int>& a, const std::vector<int>& b) {
  IntegerVector idx(no_init(a.size()));
  int max = 1 + *std::max_element(a.begin(), a.end());
  std::vector<int> n(max);
  for(int i = 0; i < a.size(); ++i) ++n[a[i]];
  std::vector<std::queue<int> > lut(max);
  for(int i = 0; i < b.size(); ++i) {
    if(b[i] < max && n[b[i]] > 0) {
      --n[b[i]];
      lut[b[i]].push(i);
    }
  }
  for(int i = 0; i < idx.size(); ++i) {
    auto & P = lut[a[i]];
    if(P.size() > 0) {
      idx[i] = P.front() + 1;
      P.pop();
    } else {idx[i] = NA_INTEGER;}
  }
  return idx;
}
)")
pm2(x, y)
#[1]  1  5 NA  2  3 NA

请注意,这些代码段都是用于优化匹配的不同方法,包括使用了 baseRCPP 和优化的 RCPP 版本。如果你需要更多的翻译或解释,请随时提出。

英文:

A variant in base using split.
split the indices of both vectors by its value. Subset the second list with the names of the first, that both have the same order. Change NULL to NA and bring the lengths of the second list to those from the first. Reorder the indices of the second list by those of the first.

x &lt;- c(3L, 1L, 2L, 3L, 3L, 2L)
y &lt;- c(3L, 3L, 3L, 3L, 1L, 3L)

a &lt;- split(seq_along(x), x)
b &lt;- split(seq_along(y), y)[names(a)]
b[lengths(b)==0] &lt;- NA
b &lt;- unlist(Map(`length&lt;-`, b, lengths(a)), FALSE, FALSE)
`[&lt;-`(b, unlist(a, FALSE, FALSE), b)
#[1]  1  5 NA  2  3 NA

I tried to exchange the part

b &lt;- split(seq_along(y), y)[names(a)]
b[lengths(b)==0] &lt;- NA

with

b &lt;- list2env(split(seq_along(y), y))
b &lt;- mget(names(a), b, ifnotfound = NA)

But it was not faster.

An RCPP version.
Store the indices of the second vector ín a queue for each unique value in an unordered_map. Iterate over all values of the first vector and take the indices from the queue.

Rcpp::sourceCpp(code=r&quot;(
#include &lt;Rcpp.h&gt;
#include &lt;unordered_map&gt;
#include &lt;queue&gt;

using namespace Rcpp;
// [[Rcpp::export]]
IntegerVector pm(const std::vector&lt;int&gt;&amp; a, const std::vector&lt;int&gt;&amp; b) {
  IntegerVector idx(no_init(a.size()));
  std::unordered_map&lt;int, std::queue&lt;int&gt; &gt; lut;
  for(int i = 0; i &lt; b.size(); ++i) lut[b[i]].push(i);
  for(int i = 0; i &lt; idx.size(); ++i) {
    auto search = lut.find(a[i]);
    if(search != lut.end() &amp;&amp; search-&gt;second.size() &gt; 0) {
      idx[i] = search-&gt;second.front() + 1;
      search-&gt;second.pop();
    } else {idx[i] = NA_INTEGER;}
  }
  return idx;
}
)&quot;)
pm(x, y)
#[1]  1  5 NA  2  3 NA

A for this case specialized RCPP version.
Create a vector of the length of the maximum value of the first vector and count how many times a value is present. Create another queue vector of the same length and sore there the indices of the values of the second vector until it has reached the number of the first. Iterate over all values of the first vector and take the indices from the queue.

Rcpp::sourceCpp(code=r&quot;(
#include &lt;Rcpp.h&gt;
#include &lt;vector&gt;
#include &lt;array&gt;
#include &lt;queue&gt;
#include &lt;algorithm&gt;

using namespace Rcpp;
// [[Rcpp::export]]
IntegerVector pm2(const std::vector&lt;int&gt;&amp; a, const std::vector&lt;int&gt;&amp; b) {
  IntegerVector idx(no_init(a.size()));
  int max = 1 + *std::max_element(a.begin(), a.end());
  std::vector&lt;int&gt; n(max);
  for(int i = 0; i &lt; a.size(); ++i) ++n[a[i]];
  std::vector&lt;std::queue&lt;int&gt; &gt; lut(max);
  for(int i = 0; i &lt; b.size(); ++i) {
    if(b[i] &lt; max &amp;&amp; n[b[i]] &gt; 0) {
      --n[b[i]];
      lut[b[i]].push(i);
    }
  }
  for(int i = 0; i &lt; idx.size(); ++i) {
    auto &amp; P = lut[a[i]];
    if(P.size() &gt; 0) {
      idx[i] = P.front() + 1;
      P.pop();
    } else {idx[i] = NA_INTEGER;}
  }
  return idx;
}
)&quot;)
pm2(x,y)
#[1]  1  5 NA  2  3 NA

Benchmark

set.seed(5)
x &lt;- sample(5e3, 1e5, replace = TRUE)
y &lt;- sample(x, replace = TRUE)

library(data.table)

matchall &lt;- function(x, y) {
  data.table(y, rowid(y))[
    data.table(x, rowid(x)), on = .(y = x, V2), which = TRUE
  ]
}

rmatch &lt;- function(x, y) {
  xp &lt;- cbind(seq_along(x), x)[order(x),]
  yp &lt;- cbind(seq_along(y), y)[order(y),]
  result &lt;- numeric(length(x))
  
  xi &lt;- yi &lt;- 1
  Nx &lt;- length(x)
  Ny &lt;- length(y)
  while (xi &lt;= Nx) {
    if (yi &gt; Ny) {
      result[xp[xi,1]] &lt;- NA
      xi &lt;- xi + 1
    } else if (xp[xi,2] == yp[yi,2]) {
      result[xp[xi,1]] = yp[yi,1]
      xi &lt;- xi + 1
      yi &lt;- yi + 1
    } else if (xp[xi,2] &lt; yp[yi,2]) {
      result[xp[xi,1]] &lt;- NA
      xi &lt;- xi + 1
    } else if (xp[xi,2] &gt; yp[yi,2]) {
      yi &lt;- yi + 1
    }
  }
  result  
}

bench::mark(
ave = ave(x, x, FUN = \(v) which(y == v[1])[1:length(v)]),
rmatch = rmatch(x, y),
make.name = match(make.names(x, TRUE), make.names(y, TRUE)),
paste = do.call(match, lapply(list(x, y), \(v) paste(v, ave(v, v, FUN = seq_along)))),
make.unique = match(make.unique(as.character(x)), make.unique(as.character(y))),
split = {a &lt;- split(seq_along(x), x)
  b &lt;- split(seq_along(y), y)[names(a)]
  b[lengths(b)==0] &lt;- NA
  b &lt;- unlist(Map(`length&lt;-`, b, lengths(a)), FALSE, FALSE)
  `[&lt;-`(b, unlist(a, FALSE, FALSE), b)},
data.table = matchall(x, y),
RCPP = pm(x, y),
RCPP2 = pm2(x, y)
)

Result

  expression       min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc
  &lt;bch:expr&gt;  &lt;bch:tm&gt; &lt;bch:tm&gt;     &lt;dbl&gt; &lt;bch:byt&gt;    &lt;dbl&gt; &lt;int&gt; &lt;dbl&gt;
1 ave            1.66s    1.66s     0.603    3.73GB    68.7      1   114
2 rmatch      258.29ms 259.35ms     3.86     5.34MB    30.8      2    16
3 make.name   155.69ms 156.82ms     6.37    14.06MB     1.59     4     1
4 paste         93.8ms 102.06ms     9.74    18.13MB     7.79     5     4
5 make.unique  81.67ms   92.8ms    10.4      9.49MB     5.22     6     3
6 split        12.66ms  13.16ms    65.8      7.18MB    16.0     33     8
7 data.table    6.22ms   6.89ms   114.       5.13MB    28.0     57    14
8 RCPP          3.06ms    3.2ms   301.     393.16KB     3.98   151     2
9 RCPP2         1.64ms   1.82ms   514.     393.16KB     8.00   257     4

In this case the C++ version is the fastest and allocates the lowest amount of memory. In case using base the splitB variant is the fastest and rmatch allocates the lowest amount of memory.

答案2

得分: 7

只是指出,您可以使用 match + make.unique 来实现相同的功能。从速度上来说,它可能比 data.table 方法慢:

match(make.unique(as.character(x)), make.unique(as.character(y)))

[1]  1  5 NA  2  3 NA

match(make.names(x, TRUE), make.names(y, TRUE))
[1]  1  5 NA  2  3 NA
英文:

Just to point out, you can use match + make.unique to accomplish the same. Speedwise, it might be slower than the data.table approach:

match(make.unique(as.character(x)), make.unique(as.character(y)))

[1]  1  5 NA  2  3 NA

match(make.names(x, TRUE), make.names(y, TRUE))
[1]  1  5 NA  2  3 NA

答案3

得分: 6

使用data.table的连接方法,受到问题的启发。

library(data.table)

matchall <- function(x, y) {
  data.table(y, rowid(y))[
    data.table(x, rowid(x)), on = .(y = x, V2), which = TRUE
  ]
}

检查行为

x <- c(3L, 1L, 2L, 3L, 3L, 2L)
y <- c(3L, 3L, 3L, 3L, 1L, 3L)

matchall(x, y)
#> [1]  1  5 NA  2  3 NA

在更大的向量上进行时间测试:

set.seed(5)
x <- sample(5e3, 1e5, replace = TRUE)
y <- sample(x, replace = TRUE)

system.time(z1 <- matchall(x, y))
#>    user  system elapsed 
#>    0.06    0.00    0.01

system.time(z2 <- ave(x, x, FUN = \(v) which(y == v[1])[1:length(v)]))
#>    user  system elapsed 
#>    0.88    0.43    1.31

identical(z1, z2)
#> [1] TRUE
英文:

Using a data.table join, inspired by this Q&A.

library(data.table)

matchall &lt;- function(x, y) {
  data.table(y, rowid(y))[
    data.table(x, rowid(x)), on = .(y = x, V2), which = TRUE
  ]
}

Check behavior

x &lt;- c(3L, 1L, 2L, 3L, 3L, 2L)
y &lt;- c(3L, 3L, 3L, 3L, 1L, 3L)

matchall(x, y)
#&gt; [1]  1  5 NA  2  3 NA

Timing on larger vectors:

set.seed(5)
x &lt;- sample(5e3, 1e5, replace = TRUE)
y &lt;- sample(x, replace = TRUE)

system.time(z1 &lt;- matchall(x, y))
#&gt;    user  system elapsed 
#&gt;    0.06    0.00    0.01

system.time(z2 &lt;- ave(x, x, FUN = \(v) which(y == v[1])[1:length(v)]))
#&gt;    user  system elapsed 
#&gt;    0.88    0.43    1.31

identical(z1, z2)
#&gt; [1] TRUE

答案4

得分: 4

如果您有额外的内存可用,可以通过对值进行排序并基本上进行两个指针的遍历来加速该过程,以匹配数据。以下是示例代码:

rmatch <- function(x, y) {
  xp <- cbind(seq_along(x), x)[order(x),]
  yp <- cbind(seq_along(y), y)[order(y),]
  result <- numeric(length(x))
  
  xi <- yi <- 1
  Nx <- length(x)
  Ny <- length(y)
  while (xi <= Nx) {
    if (yi > Ny) {
      result[xp[xi,1]] <- NA
      xi <- xi + 1
    } else if (xp[xi,2] == yp[yi,2]) {
      result[xp[xi,1]] = yp[yi,1]
      xi <- xi + 1
      yi <- yi + 1
    } else if (xp[xi,2] < yp[yi,2]) {
      result[xp[xi,1]] <- NA
      xi <- xi + 1
    } else if (xp[xi,2] > yp[yi,2]) {
      yi <- yi + 1
    }
  }
  result  
}

我还进行了一些基于R的选项的测试,如下所示:

mbm <- microbenchmark::microbenchmark(
  ave = ave(x, x, FUN = \(v) which(y == v[1])[1:length(v)]),
  rmatch = rmatch(x, y),
  pmatch = pmatch(x, y),
  times = 20
)

并且看到性能似乎表现良好:

Unit: milliseconds
   expr        min         lq       mean     median         uq        max neval
    ave  1227.6743  1247.6980  1283.1024  1264.1485  1324.1569  1349.3276    20
 rmatch   198.1744   201.1058   208.3158   204.5933   209.4863   247.7279    20
 pmatch 39514.4227 39595.9720 39717.5887 39628.0892 39805.2405 40105.4337    20

这些都返回相同的值向量。

英文:

If you have some extra memory to spare, you can speed up the process by sorting the values and basically doing a two-pointer walk through to match up the data. Here's what what would look like

rmatch &lt;- function(x, y) {
  xp &lt;- cbind(seq_along(x), x)[order(x),]
  yp &lt;- cbind(seq_along(y), y)[order(y),]
  result &lt;- numeric(length(x))
  
  xi &lt;- yi &lt;- 1
  Nx &lt;- length(x)
  Ny &lt;- length(y)
  while (xi &lt;= Nx) {
    if (yi &gt; Ny) {
      result[xp[xi,1]] &lt;- NA
      xi &lt;- xi + 1
    } else if (xp[xi,2] == yp[yi,2]) {
      result[xp[xi,1]] = yp[yi,1]
      xi &lt;- xi + 1
      yi &lt;- yi + 1
    } else if (xp[xi,2] &lt; yp[yi,2]) {
      result[xp[xi,1]] &lt;- NA
      xi &lt;- xi + 1
    } else if (xp[xi,2] &gt; yp[yi,2]) {
      yi &lt;- yi + 1
    }
  }
  result  
}

I tested with some of the other base R options posted here

mbm &lt;- microbenchmark::microbenchmark(
  ave = ave(x, x, FUN = \(v) which(y == v[1])[1:length(v)]),
  rmatch = rmatch(x, y),
  pmatch = pmatch(x, y),
  times = 20
)

And saw that it seemed to perform well

Unit: milliseconds
   expr        min         lq       mean     median         uq        max neval
    ave  1227.6743  1247.6980  1283.1024  1264.1485  1324.1569  1349.3276    20
 rmatch   198.1744   201.1058   208.3158   204.5933   209.4863   247.7279    20
 pmatch 39514.4227 39595.9720 39717.5887 39628.0892 39805.2405 40105.4337    20

These all return the same vector of values.

答案5

得分: 2

你可以简单地运行 match + paste + ave

&gt; do.call(match, lapply(list(x, y), \(v) paste(v, ave(v, v, FUN = seq_along))))
[1]  1  5 NA  2  3 NA
英文:

You can simply run match + paste + ave

&gt; do.call(match, lapply(list(x, y), \(v) paste(v, ave(v, v, FUN = seq_along))))
[1]  1  5 NA  2  3 NA

huangapple
  • 本文由 发表于 2023年6月1日 22:04:45
  • 转载请务必保留本文链接:https://go.coder-hub.com/76382756.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定