查找值第一次有效显示在列表中

Jam*_*s B 5 r

我正在尝试解决一个问题,其中有一个长长的列表,每个索引处都有数量不定的数字。目的是说每个数字出现的最早索引是什么。因此,如果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)

Jor*_*hau 2

这是另一种用于match查找第一个索引的方法。这稍微优于其他建议的方法,并产生与OP问题中类似的输出:

\n\n
## 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\n
Run 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\n
Run Code Online (Sandbox Code Playgroud)\n\n

\n