R语言 在查找表中有效地找到所有匹配的向量,并重复

exdqitrt  于 2023-11-14  发布在  其他
关注(0)|答案(6)|浏览(103)

我想在另一个查找向量table中找到向量x的所有匹配的索引。

table = rep(1:5, each=3)
x = c(2, 5, 2, 6)

字符串
标准的R基方法并不能完全给予我想要的东西,例如使用which(table %in% x)我们只能得到一次匹配的索引,即使2x中出现了两次

which(table %in% x)
# [1]  4  5  6 13 14 15


另一方面,match返回每个匹配x的值,但只返回查找表中的第一个索引。

match(x, table)
# [1]  4 13  4 NA


我想要的是一个函数,返回“所有x和所有y”的索引。即。它应该返回以下所需的结果:

mymatch(x, table)
# c(4, 5, 6, 13, 14, 15, 4, 5, 6)


当然,我们可以用R中的循环来做到这一点:

mymatch = function(x, table) {
  matches = sapply(x, \(xx) which(table %in% xx)) 
  unlist(matches)
}

mymatch(x, table)
# [1]  4  5  6 13 14 15  4  5  6


但这在大数据上非常慢(我需要在大数据上多次执行此操作)

table = rep(1:1e5, each=10)
x = sample(1:100, 1000, replace = TRUE)
system.time(mymatch(x, table))
#  user  system elapsed 
# 3.279   2.881   6.157


如果我们将其与which %in%进行比较,这是非常慢的:

system.time(which(table %in% x))
#  user  system elapsed 
# 0.003   0.004   0.008


希望有一个快速的方法在R中做到这一点?否则,也许RCpp是要走的路。

ruoxqz4g

ruoxqz4g1#

另一种方法是使用split

unlist(split(seq(table), table)[as.character(x)],use.names = FALSE)
[1]  4  5  6 13 14 15  4  5  6

字符串
编辑:
注意,如果table是排序的,那么你可以使用rle + sequence

faster <- function(x, table){
  a <- rle(table)
  n <- length(a$lengths)
  idx <- match(x, a$values, 0)
  sequence(a$lengths[idx], cumsum(c(1,a$lengths[-n]))[idx])
}

set.seed(42)
table = rep(1:1e5, each=10)
x = sample(1:100, 1000, replace = TRUE)
bench::mark(
   faster(x, table),
   #mymatch(x, table) |> as.vector(),
   join_match(x, table),
   #unlist(split(seq(table), table)[as.character(x)],use.names = FALSE),
   check = TRUE
 )

# A tibble: 2 × 13
  expression     min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory    
  <bch:expr> <bch:t> <bch:>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>    
1 faster(x,…  54.4ms  252ms      3.97    54.9MB     1.99     2     1      503ms <int>  <Rprofmem>
2 join_matc… 127.7ms  254ms      3.93    88.8MB     5.90     2     3      508ms <int>  <Rprofmem>
# ℹ 2 more variables: time <list>, gc <list>


只要表被排序,该函数就可以工作。不一定从1:n开始。

table = c(rep(1:5, each=3), 7,7,7,7,10,10)
x = c(10, 2, 5,7, 2, 6)

microbenchmark::microbenchmark(
   faster(x, table),
   #mymatch(x, table) |> as.vector(),
   join_match(x, table),
   #unlist(split(seq(table), table)[as.character(x)],use.names = FALSE),
   check = 'equal'
 )
Unit: microseconds
                 expr      min       lq       mean   median       uq       max neval
     faster(x, table)   23.001   32.751   56.95703   56.400   66.201   222.901   100
 join_match(x, table) 4216.201 4925.302 6616.51401 5572.951 7842.200 21153.402   100

gab6jxml

gab6jxml2#

也许data.table会是一个选择?如果你有相对较大的table/vector,你可能会看到速度的提高,特别是如果你使用Jon Spring的“join”方法的沿着:

library(tidyverse)
library(data.table)
#> 
#> Attaching package: 'data.table'
#> The following objects are masked from 'package:lubridate':
#> 
#>     hour, isoweek, mday, minute, month, quarter, second, wday, week,
#>     yday, year
#> The following objects are masked from 'package:dplyr':
#> 
#>     between, first, last
#> The following object is masked from 'package:purrr':
#> 
#>     transpose
library(microbenchmark)

onyambu_faster <- function(x, table){
  a <- rle(table)
  n <- length(a$lengths)
  idx <- match(x, a$values, 0)
  sequence(a$lengths[idx], cumsum(c(1,a$lengths[-n]))[idx])
}

jon_spring_join_match = function(x, table) {
  t <- data.frame(table, index = 1:length(table))
  xt <- data.frame(x, index = 1:length(x))
  t |>
    left_join(xt, join_by(table == x), relationship = 'many-to-many') |>
    arrange(index.y) %>%
    filter(!is.na(index.y)) %>%
    pull(index.x)
}

jared_mamrot_dt <- function(x, table){
  table_dt <- data.table(table, index = 1:length(table))
  x_dt <- data.table(x, index = 1:length(x))
  return(na.omit(table_dt[x_dt, on = .(table == x)][,index]))
}

table = rep(1:1e5, each=10)
x = sample(1:100, 1000, replace = TRUE)

all.equal(onyambu_faster(x, table), jared_mamrot_dt(x, table))
#> [1] TRUE
all.equal(jon_spring_join_match(x, table), jared_mamrot_dt(x, table))
#> [1] TRUE

res <- microbenchmark(onyambu_faster(x, table),
                      jon_spring_join_match(x, table),
                      jared_mamrot_dt(x, table),
                      times = 10)
res
#> Unit: milliseconds
#>                             expr       min       lq      mean   median
#>         onyambu_faster(x, table) 38.196317 45.08884  65.22651 52.40748
#>  jon_spring_join_match(x, table) 48.697968 74.54407 105.79551 83.11473
#>        jared_mamrot_dt(x, table)  9.441176 11.34315  12.99648 11.76324
#>         uq       max neval cld
#>   64.88688 129.38505    10 a  
#>  131.50681 221.16477    10  b 
#>   14.05289  21.84779    10   c
autoplot(res)

字符串
x1c 0d1x的数据
创建于2023-10-26带有reprex v2.0.2

tpgth1q7

tpgth1q73#

作为连接应该更快。这是> 100倍的速度。

library(dplyr)
join_match = function(x, table) {
  t <- data.frame(table, index = 1:length(table))
  xt <- data.frame(x, index = 1:length(x))
  t |>
    left_join(xt, join_by(table == x), relationship = 'many-to-many') |>
    arrange(index.y) %>%
    filter(!is.na(index.y)) %>%
    pull(index.x)
}

字符串
同样的输出,100- 200倍的速度,和来自@Onyambu的基本R建议一样快~ 3倍(注意:这种方法已经更新到类似的速度,而data.table解决方案甚至更快。使用duckdb,或箭头,或折叠来做连接可能会更快。但我的观察仍然是,你可以通过将其视为连接来获得显着的速度改进+易读性):

set.seed(42)
table = rep(1:1e5, each=10)
x = sample(1:100, 1000, replace = TRUE)
bench::mark(
  mymatch(x, table) |> as.vector(),
  join_match(x, table),
  unlist(split(seq(table), table)[as.character(x)],use.names = FALSE),
  check = TRUE
)

# A tibble: 3 × 13
  expression                                                                min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result
  <bch:expr>                                                           <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>
1 as.vector(mymatch(x, table))                                            13.8s    13.8s    0.0727    14.9GB     2.83     1    39      13.8s <int> 
2 join_match(x, table)                                                   48.7ms   62.2ms   13.8       88.8MB     3.95     7     2    506.3ms <int> 
3 unlist(split(seq(table), table)[as.character(x)], use.names = FALSE)  183.6ms  184.5ms    5.31      29.8MB     0        3     0    564.9ms <int>

huus2vyu

huus2vyu4#

使用问题中的数据,这是基于我机器上的中值时间的两倍。

table = rep(1:5, each=3)
x = c(2, 5, 2, 6)

mymatch = function(x, table) {
  matches = sapply(x, \(xx) which(table %in% xx)) 
  unlist(matches)
}

outer_match <- function(x, table) {
  z1 <- outer(table, x, "==") 
  z2 <- z1 * row(z1)
  z2[z2 != 0]
}

outer_match(x, table)
## [1]  4  5  6 13 14 15  4  5  6

library(microbenchmark)
microbenchmark(
 mymatch(x, table),
 outer_match(x, table)
)
## Unit: microseconds
##                   expr  min    lq    mean median   uq    max neval cld
##      mymatch(x, table) 77.0 79.15 166.696  82.75 84.3 8384.9   100   a
##  outer_match(x, table) 35.1 36.75 115.783  41.95 43.1 7410.1   100   a

字符串

pbpqsu0x

pbpqsu0x5#

您可以简单地运行outer + row(简短的代码,但由于outer的原因,可能不是那么有效),例如,

> row(d <- outer(table, x, `==`))[d]
[1]  4  5  6 13 14 15  4  5  6

字符串

au9on6nz

au9on6nz6#

如果被匹配的值是整数,那么你可以将它们作为一个包含你想要的索引值的列表中的索引值(只要最大整数不是太大,以至于列表超过了你的RAM容量)。

# Process the table vector every time
anjama_list <- function(x, table) {
  l = vector("list", max(table))
  
  i = 0
  for (val in table) {
    i = i + 1
    l[[val]] = c(l[[val]], i)
  }
  
  return(unlist(l[x]))
}

字符串
现在,这并不像这里提到的其他解决方案那么快,但是因为你要重用表进行多次查找,我们可以预先计算列表的创建并在迭代中重用它:

# If the table vector is being reused, only need to process it once
l = vector("list", max(table))

i = 0
for (val in table) {
  i = i + 1
  l[[val]] = c(l[[val]], i)
}

# Now that the list is created, we can do as many lookups as we want without that cost
anjama_list_cache <- function(x, l) {
  return(unlist(l[x]))
}


事实证明,列表查找和取消列表部分非常便宜:


的数据

  • 使用jared_mamrot的答案中的代码创建的图。*

所以,这取决于重复使用相同的表向量多少次来弥补初始设置。就内存使用而言,我认为查找和取消列表也应该相当有效(查找基本上什么都没有,取消列表与x向量的大小有关),但我还没有尝试过分析它们。

相关问题