我正在為嵌套在串列中的隨機子集向量尋找快速解決方案。
如果我們模擬以下資料，我們會得到一個l包含 300 萬個向量的串列，每個向量的長度為 5。但我希望每個向量的長度不同。所以我想我應該應用一個隨機子集每個向量的函式。問題是，這種方法沒有我希望的那么快。
模擬資料：串列 l
library(stringi)
set.seed(123)
vec_n <- 15e6
vec_vals <- 1:vec_n
vec_names <- stringi::stri_rand_strings(vec_n, 5)
my_named_vec <- setNames(vec_vals, vec_names)
split_func <- function(x, n) {
unname(split(x, rep_len(1:n, length(x))))
}
l <- split_func(my_named_vec, n = vec_n / 5)
head(l)
#> [[1]]
#> HmPsw Qk8NP Quo3T 8f0GH nZmjN
#> 1 3000001 6000001 9000001 12000001
#>
#> [[2]]
#> 2WtYS ZaHFl 6YjId jbGuA tAG65
#> 2 3000002 6000002 9000002 12000002
#>
#> [[3]]
#> xSgZ6 jM5Uw ujPOc CTV5F 5JRT5
#> 3 3000003 6000003 9000003 12000003
#>
#> [[4]]
#> tF2Kx r4ZCI Ooklo VOLHU M6z6H
#> 4 3000004 6000004 9000004 12000004
#>
#> [[5]]
#> tgdze w8d1B FYERK jlClo NQfsF
#> 5 3000005 6000005 9000005 12000005
#>
#> [[6]]
#> hXaH9 gsY1u CjBwC Oqqty dxJ4c
#> 6 3000006 6000006 9000006 12000006
現在我們有了l，我希望隨機地對每個向量進行子集：這意味著被子集化的元素數量（每個向量）將是隨機的。所以一種選擇是設定以下效用函式：
randomly_subset_vec <- function(x) {
my_range <- 1:length(x)
x[-sample(my_range, sample(my_range))]
}
lapply(head(l), randomly_subset_vec)
#> [[1]]
#> Quo3T
#> 6000001
#>
#> [[2]]
#> 6YjId jbGuA
#> 6000002 9000002
#>
#> [[3]]
#> xSgZ6 jM5Uw ujPOc CTV5F
#> 3 3000003 6000003 9000003
#>
#> [[4]]
#> Ooklo
#> 6000004
#>
#> [[5]]
#> named integer(0)
#>
#> [[6]]
#> CjBwC Oqqty dxJ4c
#> 6000006 9000006 12000006
但是在整個程序中運行這個程序l需要永遠。我試過使用rrapplywhich 是一個處理串列的快速包，它在我的機器上“只”需要 110 秒。
library(rrapply)
library(tictoc)
tic()
l_subsetted <- rrapply(object = l, f = randomly_subset_vec)
toc()
#> 110.23 sec elapsed
我會對以下任一情況感到滿意：
- 是否有更快的替代方案：
rrapply(object = l, f = randomly_subset_vec) - 或者更一般地說，有沒有更快的方式開始
my_named_vec和到達l_subsetted？
uj5u.com熱心網友回復：
簡化采樣函式：
randomly_subset_vec_2 <- function(x) {
my_range <- length(x)
x[-sample(my_range, sample(my_range, 1))]
}
僅此一項就可以顯著加快速度。
雖然我沒有測驗過，但根據問題描述，洗掉一些元素（前面的減號sample）就是保留其他元素。為什么不提取一些元素（沒有減號）從而保留那些？
更簡單、更快：x迄今為止，直接采樣是最快的。
randomly_subset_vec_3 <- function(x) {
sample(x, sample(length(x), 1))
}
uj5u.com熱心網友回復：
非常粗糙，我對此并不特別自豪。我確信有一種更優雅的方式，但這在我的機器上運行了幾秒鐘
> # Make some fake data
> out <- lapply(1:3000000, function(i){sample(LETTERS, 5, replace = FALSE)})
> out[1:5]
[[1]]
[1] "D" "H" "C" "Y" "V"
[[2]]
[1] "M" "E" "H" "G" "S"
[[3]]
[1] "R" "P" "O" "L" "M"
[[4]]
[1] "C" "U" "G" "Q" "X"
[[5]]
[1] "Q" "L" "W" "O" "V"
> # Create list with ids to sample
> id <- lapply(1:3000000, function(i){sample(1:5, sample(1:5, 1), replace = FALSE)})
> id[1:5]
[[1]]
[1] 2
[[2]]
[1] 2 3 4 1 5
[[3]]
[1] 4
[[4]]
[1] 5
[[5]]
[1] 1 2
> # Extract the ids from the original data using the id list.
> # Like I said I'm not particularly proud of this but it gets the job
> # done quick enough on my computer
> out <- lapply(1:3000000, function(i){out[[i]][id[[i]]]})
> out[1:5]
[[1]]
[1] "H"
[[2]]
[1] "E" "H" "G" "M" "S"
[[3]]
[1] "L"
[[4]]
[1] "X"
[[5]]
[1] "Q" "L"
uj5u.com熱心網友回復：
也許我們可以randomly_subset_vec用sample和替換更簡單的東西sample.int：
lapply(l, function(x) x[sample.int(5, sample(5, 1))])
uj5u.com熱心網友回復：
似乎最大的瓶頸是運行所有sample呼叫，因此我們可以嘗試以下操作。一種方法是Julius Vainora的解決方案。首先，我們生成funFast的Rcpp：
library(inline)
library(Rcpp)
src <-
'
int num = as<int>(size), x = as<int>(n);
Rcpp::NumericVector vx = Rcpp::clone<Rcpp::NumericVector>(x);
Rcpp::NumericVector pr = Rcpp::clone<Rcpp::NumericVector>(prob);
Rcpp::NumericVector rnd = rexp(x) / pr;
for(int i= 0; i<vx.size(); i) vx[i] = i;
std::partial_sort(vx.begin(), vx.begin() num, vx.end(), Comp(rnd));
vx = vx[seq(0, num - 1)] 1;
return vx;
'
incl <-
'
struct Comp{
Comp(const Rcpp::NumericVector& v ) : _v(v) {}
bool operator ()(int a, int b) { return _v[a] < _v[b]; }
const Rcpp::NumericVector& _v;
};
'
funFast <- cxxfunction(signature(n = "Numeric", size = "integer", prob = "numeric"),
src, plugin = "Rcpp", include = incl)
然后，定義一個替代randomly_subset_vec使用funFast而不是sample：
'randomly_subset_vec_2' <- function(x) {
range <- length(x)
probs <- rep(1/range, range)
o <- funFast(range, size = funFast(range, size = 1, prob = probs), prob = probs)
return(x[-o])
}
tic();obj <- rrapply(object = l, f = randomly_subset_vec_2);toc();
uj5u.com熱心網友回復：
您的子集不包括完整集，因此這首先從每個向量中洗掉一個隨機元素，然后隨機保留所有其他元素：
system.time({
lenl <- lengths(l)
# use stack to unlist the list while keeping the originating list index for each value
temp <- stack(setNames(l, seq_along(l)))[
# randomly remove one value from each vector
-(ceiling(runif(length(l))*lenl) c(0, head(cumsum(lenl), -1))),][
# randomly keep the remaining elements
sample(c(FALSE, TRUE), sum(lenl) - length(l), replace = TRUE),]
# re-list
l_subsetted <- unname(split(setNames(temp$values, rownames(temp)), temp$ind))
})
user system elapsed
25.360 0.220 25.576
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/343664.html
上一篇：pivot_longer用于具有相同名稱的多個集合_to
下一篇：如何重疊PCA圖中的不同資訊？