向量化 R 中使用 unique 函数的 for 循环答案

【问题标题】：Vectorizing a for loop in R that uses the unique function向量化 R 中使用 unique 函数的 for 循环
【发布时间】：2016-12-07 00:34:02
【问题描述】：

player_ids = c(34, 87, 27, 34, 87, 9, 29, 25, 24, 25, 34, 37)
end = length(player_ids)
unique_players_list = list()

for(i in 1:end) {
  unique_players_list[[i]] = unique(player_ids_unlisted[1:i])
}

这是我正在尝试矢量化的 for 循环的（缩短版本）。我不确定如何发布代码输出，但是列表 unique_players_list 应该具有以下输出：

unique_players_list[[1]] == c(34)
unique_players_list[[2]] == c(34)
unique_players_list[[3]] == c(34, 87)
unique_players_list[[4]] == c(34, 87, 27)     
unique_players_list[[5]] == c(34, 87, 27)

“等等。输出不必在列表中，我实际上更喜欢数据帧，但是我需要这个矢量化，因为我当前的 for 循环需要永远，我需要运行这个代码数万次。”

谢谢！

【问题讨论】：

这不是真正的矢量化——它是累积。您可能可以通过单个 unique 调用和 match 非常有效地执行此操作，以获取每个元素第一次出现的位置。
我不确定您希望如何在数据框中使用它，因为根据定义，结果似乎不是矩形的。你希望有一列向量吗？
我知道整个容器中唯一元素的最大数量是多少，并且会为数据框创建那么多列
是的，对不起，我的意思是= unique(player_ids[1:i])
我不认为它很快，但这本质上是Reduce(union, player_ids, accumulate=TRUE)

标签： r list loops unique vectorization

【解决方案1】：

这个问题的一个相当字面意思的实现是沿着玩家 id 应用，返回 id 头部的唯一元素

f0 <- function(player_ids)
    lapply(seq_along(player_ids), function(i) unique(head(player_ids, i)))

这样就避免了对结果列表的分配进行管理，同时也处理了length(player_ids) == 0L时的情况。为了更有效地实施，请创建“累积”集列表

uid <- unique(player_ids)
sets <- lapply(seq_along(uid), function(i) uid[seq_len(i)])

然后识别属于第 i 个索引的集合

did <- !duplicated(player_ids)
sets[cumsum(did)]

这是目前为止的一些解决方案

f1 <- function(player_ids) {
    end = length(player_ids)
    tank <- player_ids[1]

    unique_players_list = vector("list", end)
    for(i in 1:end) {
        if (!player_ids[i] %in% tank) tank <- c(tank, player_ids[i])
        unique_players_list[[i]] = tank
    }
    unique_players_list
}

f2 <- function(player_ids) {
    un = unique(player_ids)
    ma = match(un, player_ids)
    li = vector("list", length(player_ids))

    for (i in seq_along(player_ids))
        li[[i]] = un[ma <= i]
    li
}

f3 <- function(player_ids) {
    uid <- unique(player_ids)
    sets <- lapply(seq_along(uid), function(i) uid[seq_len(i)])
    sets[cumsum(!duplicated(player_ids))]
}

他们正在产生合理结果的一些基本测试

> identical(f1(player_ids), f2(player_ids))
[1] TRUE
> identical(f1(player_ids), f3(player_ids))
[1] TRUE

以及对更大数据集的性能评估

> library(microbenchmark)
> ids <- sample(100, 10000, TRUE)
> microbenchmark(f1(ids), f2(ids), f3(ids), times=10)
Unit: microseconds
    expr       min        lq       mean     median        uq       max neval
 f1(ids) 24397.193 25820.375 32055.5720 26475.8245 28030.866 56487.781    10
 f2(ids) 20607.564 22148.888 34462.5850 24432.4785 51722.208 53473.468    10
 f3(ids)   414.649   458.271   772.3738   501.5185   686.383  2163.261    10

f3() 在初始值的向量与唯一值的数量相比较大时表现良好。这是一个数据集，其中原始向量中的元素大多是唯一的，并且时序更具可比性

> ids <- sample(1000000, 10000, TRUE)
> microbenchmark(f1(ids), f2(ids), f3(ids), times=10)
Unit: milliseconds
    expr      min       lq     mean   median       uq      max neval
 f1(ids) 214.2505 232.3902 233.7632 233.4617 237.5509 249.4652    10
 f2(ids) 433.5181 443.5987 512.4475 463.8388 467.3710 949.4882    10
 f3(ids) 299.2291 301.4931 307.7576 302.9375 316.6055 321.3942    10

正确处理边缘情况可能很重要，一个常见的问题是零长度向量，例如，f2(integer())。 f1() 不处理这种情况。有趣的是，我认为所有实现都与输入类型无关，例如，f1(sample(letters, 100, TRUE)) 有效。

一些离线讨论导致返回格式既不方便也不节省内存的建议，并且duplicated() 和unique() 在某种程度上是相似的操作，因此我们应该能够通过一次调用而侥幸逃脱。这导致了以下解决方案，它返回一个唯一标识符列表和每个 player_id 到唯一标识符末尾的偏移量

f5 <- function(player_ids) {
    did <- !duplicated(player_ids)
    list(uid = player_ids[did], end_idx = cumsum(did))
}

结果不能与identical() 或类似的直接比较。更新后的f3() 是

f3a <- function(player_ids) {
    did <- !duplicated(player_ids)
    uid <- player_ids[did]
    sets <- lapply(seq_along(uid), function(i) uid[seq_len(i)])
    sets[cumsum(did)]
}

这里有几个性能指标

> ids <- sample(100, 10000, TRUE)
> print(object.size(f3(ids)), units="auto")
4.2 Mb
> print(object.size(f5(ids)), units="auto")
39.8 Kb
> microbenchmark(f3(ids), f3a(ids), f5(ids), times=10)
Unit: microseconds
    expr     min      lq     mean   median      uq     max neval
 f3(ids) 437.663 445.091 450.3965 447.3755 452.629 476.016    10
f3a(ids) 342.378 351.408 385.0844 354.2375 369.861 638.084    10
 f5(ids) 125.956 127.684 129.9898 128.5890 130.202 140.521    10

和

> ids <- sample(1000000, 10000, TRUE)
> microbenchmark(f3(ids), f3a(ids), f5(ids), times=10)
Unit: microseconds
     expr        min         lq         mean     median          uq         max
  f3(ids) 816317.361 821892.902  911862.5561 831274.596 1107496.984 1112586.295
 f3a(ids) 824593.618 827590.130 1009032.9519 829197.863  838559.619 2607916.641
  f5(ids)    213.677    270.397     313.1614    282.213     315.683     601.724
 neval
    10
    10
    10

【讨论】：

漂亮！我很惊讶你的f3 的速度有多快。
这个解决方案很巧妙
当我运行您的第二个基准测试时，我仍然看到 f3 在 R 3.2.5 上大幅获胜（f1:f2:f3 的相对时间约为 10:7:4）。
@Frank 当我跑的时候（上升到times = 50）我的相对结果是2.2 : 1.6 : 1，这与你的非常接近（并且与答案中发布的顺序不同）。跨度>

【解决方案2】：

我怀疑您发布的代码中有错字。我想你的意思是

unique_players_list[[i]] = unique(player_ids[1:i])

嗯，你的循环慢的原因是你在每次迭代中执行unique()。在第 i 次迭代中，成本为 O(i)，然后当您沿着 1:n 循环时，成本总计为 O(n^2)，最终成本太高。

我们想要的是线性成本：O(n)。以下代码执行此操作。基本上，我们初始化 tank 以保存已识别的唯一值，然后在出现新值时对其进行更新。

player_ids <- c(34, 87, 27, 34, 87, 9, 29, 25, 24, 25, 34, 37)
end <- length(player_ids)
tank <- player_ids[1]

unique_players_list <- vector(mode = "list", end)
for(i in 1:end) {
  if (!player_ids[i] %in% tank) tank <- c(tank, player_ids[i])
  unique_players_list[[i]] <- tank
}

对于这种类型的运算，第i+1个结果依赖于第i个结果，向量化是不可能的。

【讨论】：

预分配unique_players_list以避免重复复制，unique_players_list = vector("list", end)
是的，试试player_ids = sample(100, 10000, TRUE)；对我来说，预分配速度快了 10 倍。
这对我来说运行得更快了，谢谢Zheyuan Li。然而，现在几乎所有元素的唯一玩家列表都是空白的，只有在找到新的唯一元素时才会输入 if 案例并更新列表——尽管这是我可以自己完成的修复
@ZheyuanLi 这听起来像是一个新问题，对于 cmets 来说可能太长了，如果它可以搜索并有一个精心编写的答案会很有趣。（好答案，顺便说一句）
我很尴尬地承认其中涉及了多少试验和错误 - 我知道可以用 unique 和 match 完成一些事情（因为 match 匹配第一次出现），然后我只是尝试了两三件事，直到成功。

【解决方案3】：

我会这样做。我们可以在循环之前使用大量的向量化函数，并在循环内使用简单的索引。

un = unique(player_ids)
ma = match(un, player_ids)
li = vector("list", length(player_ids))

for (i in seq_along(player_ids)) {
    li[[i]] = un[ma <= i]
}

head(li)
# [[1]]
# [1] 34
# 
# [[2]]
# [1] 34 87
# 
# [[3]]
# [1] 34 87 27
# 
# [[4]]
# [1] 34 87 27
# 
# [[5]]
# [1] 34 87 27
# 
# [[6]]
# [1] 34 87 27  9

【讨论】：