是否有更有效的匹配版本来搜索数字的重复排列？

Posted 2023-02-23

【中文标题】是否有更有效的匹配版本来搜索数字的重复排列？

【英文标题】：Is there a more efficient version of match for searching repeated permutations of numbers?

【发布时间】：2020-07-15 03:59:28

【问题描述】：

我有一个包含 20 行和 n 列的数据集。我最初使用 n=10000，但发现我需要使用更大的数字，可能超过十倍。该数据集的每一列都是独立于其他列生成的，并且包含从 1 到 20 的整数的随机但有偏差的排列。我希望将每个数字在整个数据集中的位置求和。换句话说，我想知道数字 a 在每个 a 和 b 的第 b 个位置出现了多少次（即我的最终结果是一个 20*20 的值表）。

我相信我已经有了可以实现这一目标的代码。例如，我的计算机在两分钟内处理了整个 n=10000 原因（即它为我提供了每个 a 和 b 的计数）。但是，n=100000 和较小的 n=50000 都花了很长时间，以至于我的耐心耗尽了。我的大部分代码都非常简单，我确信效率低下是在以下几行中使用match（a、b 和n 如上所述，data 是数据集）：

list<-c()
  for(k in 1:n)
  
    position<-match(a, data[,k])
    list<-c(list,position)
  
  return(sum(list==b))

我该如何改进呢？ matchappears to be notoriously slow，但是我看到的所有解决方案（example）既不是通用解决方案，也不适用于这种情况。

如果您希望对您的解决方案进行基准测试，replicate(n,sample(20)) 将生成与我的数据集类似的列表。

【问题讨论】：

嗨，J. Mini，如果您提供能够产生预期结果的工作代码，会更容易提供帮助。

@IanCampbell 这似乎是一个不必要的并发症。我已将其隔离为我坚信是唯一相关的行，并给出了我认为足够的上下文。替代方案会多次增加此问题中的代码量，并且额外的所需上下文可能会混淆问题。

我不同意，正如@chinsoon12 所示，拥有预期结果提供了使用正交技术并轻松验证结果的机会。

@IanCampbell 的意思是您需要举例说明什么是 a ，什么是 b 并显示您从 sum(list==b) 获得的输出。无需增加一行代码，只需定义a和b即可。

【参考方案1】：

如果我理解正确，这可以快速完成，无需任何包装：

n <- 10000
k <- 20
data <- replicate(n, sample(k))


## The result: a k times k array.
## E.g. result[1, 5] tells you how often 
## 5 appears in row 1.

result <- array(NA, dim = c(k, k))


for (i in 1:k) 
    tmp <- data[seq(i, to = length(data), by = k)]
    for (j in 1:k)
        result[i, j] <- sum(tmp == j)

对于一百万个样本 (n == 1e6)，大约需要 2 秒左右。

【参考方案2】：

这在我两岁的 Macbook Pro 上大约需要 1.4 秒（尽管@chinsoon12 的 data.table 解决方案要快得多——在我的机器上大约需要 0.04 秒）：

library(tidyverse)

# Fake data matrix, 20 rows x 100,000 columns
n = 100000
set.seed(2)
d = replicate(n, sample(1:20))

# Convert to long data frame and count positions
d %>% 
  as_tibble() %>% 
  pivot_longer(cols=everything()) %>% 
  arrange(name) %>% 
  mutate(position = rep(1:20, n)) %>% 
  group_by(value, position) %>% 
  tally

   value position     n
   <int>    <int> <int>
 1     1        1  4901
 2     1        2  5031
 3     1        3  4980
 4     1        4  4997
 5     1        5  4959
 6     1        6  5004
 7     1        7  4888
 8     1        8  5021
 9     1        9  4970
10     1       10  4986
# … with 390 more rows

【参考方案3】：

避免在循环中增加对象并记录初始化然后分配给对象。考虑sapply 或稍快一点的vapply（验证类型和长度返回）：

myVec <- sapply(seq(n), function(k) match(a, data[,k]))
sum(myVec==b)

myVec <- vapply(seq(n), function(k) match(a, data[,k]), integer(1))
sum(myVec==b)

【参考方案4】：

使用data.table的选项：

library(data.table)
DT <- data.table(ri=rep(1:20, n), v=as.vector(l))
dcast(DT, ri ~ v, length)

输出：

    ri   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20
 1:  1 499 506 481 507 434 498 537 493 495 474 504 506 545 499 492 467 510 527 507 519
 2:  2 506 513 473 521 520 492 508 518 469 520 491 463 495 520 499 526 502 481 492 491
 3:  3 481 499 510 480 506 499 493 522 512 507 516 484 516 482 536 476 509 477 500 495
 4:  4 502 498 519 532 493 522 481 515 542 488 471 496 466 443 460 505 531 481 532 523
 5:  5 497 468 523 492 475 430 502 491 526 514 490 528 460 498 471 557 488 547 521 522
 6:  6 514 505 497 506 533 505 482 462 536 508 482 533 505 497 527 496 479 479 479 475
 7:  7 525 522 511 476 502 536 508 486 495 452 493 506 507 498 530 498 475 478 498 504
 8:  8 544 450 521 528 491 497 534 503 504 497 506 464 485 501 511 467 478 484 523 512
 9:  9 442 515 515 507 496 515 460 537 528 510 490 500 526 510 499 508 497 517 465 463
10: 10 513 505 497 517 486 483 518 483 503 491 495 514 507 483 485 514 516 501 498 491
11: 11 480 530 491 486 503 507 517 487 467 499 504 497 496 521 499 444 525 511 500 536
12: 12 507 464 506 537 516 489 480 500 450 507 490 539 482 484 508 483 522 519 471 546
13: 13 501 527 521 443 510 527 507 507 492 547 486 465 515 544 504 472 502 529 456 445
14: 14 478 494 502 464 495 515 503 504 514 475 522 471 529 487 509 548 500 505 510 475
15: 15 489 513 488 505 532 487 506 525 438 530 534 497 494 475 491 494 468 499 544 491
16: 16 520 484 467 516 480 498 508 503 512 472 535 503 533 526 505 508 495 477 460 498
17: 17 512 465 491 514 516 469 487 485 491 465 522 550 494 514 506 542 508 476 490 503
18: 18 505 526 503 499 502 518 484 489 508 513 476 491 505 478 482 523 500 461 555 482
19: 19 528 508 492 488 513 513 493 474 500 510 467 474 463 543 482 495 523 522 505 507
20: 20 457 508 492 482 497 500 492 516 518 521 526 519 477 497 504 477 472 529 494 522

数据：

set.seed(0L)
n <- 1e4
l <- replicate(n, sample(20))

【参考方案5】：

我认为主要的瓶颈是您正在增加循环中向量的大小。尝试在循环之前对其进行初始化并在向量中分配值。

list_vec <- numeric(length = n)

for(k in 1:n) 
  list_vec[k] <- match(a, data[,k])

或使用sapply

sapply(data, function(x) match(a, x))

【讨论】：

除非我弄错了，否则这两个代码块是不等价的。也许你想要apply(data, 2, function(x) match(a, x))？

apply(data, 2, fn) 等价于sapply(data, fn) 或lapply(data, fn)。