Существует ли более эффективный вариант поиска для поиска повторяющихся комбинаций чисел?

Question

У меня есть набор данных с 20 строками и n столбцами. Первоначально я работал с n = 10000, но обнаружил, что мне нужно использовать гораздо большее число, возможно, в десять раз больше. Каждый столбец этого набора данных генерируется независимо от других и содержит случайную, но смещенную перестановку целых чисел от 1 до 20. I sh для суммирования местоположений каждого числа по всему набору данных. Другими словами, я хочу знать, сколько раз число a появлялось в b-й позиции для каждых a и 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))

как я могу улучшить это? match кажется очень медленным , но все решения, которые я видел ( пример ), не являются ни общим решением, ни применимым к этому случаю.

Если вы будете sh для сравнения своего решения replicate(n,sample(20)) создаст список, аналогичный моему набору данных.

Answer 1

Я думаю, что основным узким местом является то, что вы увеличиваете размер вектора в l oop. Попробуйте инициализировать его до l oop и назначить значение в векторе.

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))

Answer 2

Если я правильно понимаю, это можно сделать быстро, без какой-либо упаковки:

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 секунд или около того.

Answer 3

Это заняло около 1,4 секунды на моем двухлетнем Macbook Pro (хотя решение data.table @ chinsoon12 намного быстрее - на моей машине около 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

Answer 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))

Answer 5

Избегайте растущих объектов в al oop и учета инициализации, а затем присвоения объектам. Рассмотрим 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)