我正在尝试解决一个问题,其中有一个长长的列表,每个索引处都有数量不定的数字。目的是说每个数字出现的最早索引是什么。因此,如果15在列表中的索引45和78处出现,那么我应该返回15在48处的第一个位置。在最初的问题中,它继续使用长度为10,000的列表,因此快速执行此操作很有帮助。
最初,我尝试使用现有的列表结构,并做了类似的事情,它在10,000行时非常慢。
set.seed(1)
x <- replicate(100, sample(100, sample(10, 1)))
cbind(value = 1:100,
index = sapply(1:100, function(i) which.max(sapply(x, function(x) i %in% x))))
Run Code Online (Sandbox Code Playgroud)
最终,我尝试将数据转换为data.table,效果更好,但是我一直想知道是否有更好的方法来解决问题。就像默认列表结构本质上效率低下一样,还是有更好的方法可以使用它?
set.seed(1)
x <- replicate(100, sample(100, sample(10, 1)))
dt <- data.table(index = rep(1:100, sapply(x, length)), value = unlist(x))
dt[,.(index = first(index)),value][order(value)]
Run Code Online (Sandbox Code Playgroud)
如果有帮助,这里是原始问题的完整数据集。
library(RcppAlgos)
library(memoise)
library(data.table)
jgo <- function(n) {
if (isPrimeRcpp(n) | n == 1) return (n)
div <- divisorsRcpp(n)
div <- div[-c(1, length(div))]
div <- Map(function(a, b) c(a, b), div, rev(div))
div2 <- lapply(div, function(x) lapply(jgo(x[1]), c, x[2]))
unique(lapply(c(div, unlist(div2, recursive = FALSE)), sort))
}
jgo <- memoise(jgo)
x <- lapply(1:12500, function(x) x - sapply(jgo(x), sum) + sapply(jgo(x), length))
Run Code Online (Sandbox Code Playgroud)
这是另一种用于match查找第一个索引的方法。这稍微优于其他建议的方法,并产生与OP问题中类似的输出:
## dummy data\nset.seed(1)\nx <- replicate(100, sample(100, sample(10, 1)))\n\n## use match to find first indices\nfirst_indices_match <- function(x) {\n seq_x <- 1:length(x)\n matrix(c(seq_x, rep(seq_x, lengths(x))[match(seq_x, unlist(x))]), \n ncol = 2, dimnames = list(NULL, c("value", "index"))) \n}\n\nhead(first_indices_match(x))\n#> value index\n#> [1,] 1 1\n#> [2,] 2 7\n#> [3,] 3 45\n#> [4,] 4 38\n#> [5,] 5 31\n#> [6,] 6 7\n\n## data.table approach\nlibrary(data.table)\n\nfirst_indices_dt <- function(x) {\n dt <- data.table(index = rep(seq_along(x), sapply(x, length)), value = unlist(x))\n dt[,.(index = first(index)),value][order(value)]\n\n}\n\nhead(first_indices_dt(x))\n#> value index\n#> 1: 1 1\n#> 2: 2 7\n#> 3: 3 45\n#> 4: 4 38\n#> 5: 5 31\n#> 6: 6 7\nRun Code Online (Sandbox Code Playgroud)\n\n基准测试
\n\n## stack + remove duplicate approach\nfirst_indices_shree <- function(x) {\n names(x) <- seq_len(length(x))\n (d <- stack(x))[!duplicated(d$values), ]\n}\n\n## benchmarks several list sizes\nbnch <- bench::press(\n n_size = c(100, 1E3, 1E4),\n {\n x <- replicate(n_size, sample(n_size, sample(10, 1)))\n bench::mark(\n match = first_indices_match(x),\n shree = first_indices_shree(x),\n dt = first_indices_dt(x),\n check = FALSE\n )\n } \n)\n#> # A tibble: 9 x 7\n#> expression n_size min median `itr/sec` mem_alloc `gc/sec`\n#> <bch:expr> <dbl> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>\n#> 1 match 100 18.17\xc2\xb5s 21.2\xc2\xb5s 45639. 637.3KB 27.4 \n#> 2 shree 100 361.88\xc2\xb5s 411.06\xc2\xb5s 2307. 106.68KB 11.1 \n#> 3 dt 100 759.17\xc2\xb5s 898.26\xc2\xb5s 936. 264.58KB 8.51\n#> 4 match 1000 158.34\xc2\xb5s 169.9\xc2\xb5s 5293. 164.15KB 30.8 \n#> 5 shree 1000 1.54ms 1.71ms 567. 412.52KB 13.2 \n#> 6 dt 1000 1.19ms 1.4ms 695. 372.13KB 10.7 \n#> 7 match 10000 3.09ms 3.69ms 255. 1.47MB 15.9 \n#> 8 shree 10000 18.06ms 18.95ms 51.5 4.07MB 12.9 \n#> 9 dt 10000 5.65ms 6.33ms 149. 2.79MB 20.5\nRun Code Online (Sandbox Code Playgroud)\n\n