DGB*_*DGB 4 sorting algorithm r
我有一个长度为 N 的未排序向量。向量的每个元素出现恰好两次(向量长度是偶数)。我有一个自定义排序算法,目标是迭代,直到向量达到每个元素与其副本相邻的状态。
Unsorted vector = {A,F,J,E,F,A,J,E}
A valid sorted state = {A,A,J,J,E,E,F,F}
Another valid sorted state = {J,J,A,A,F,F,E,E}
所以我的问题在于检查排序状态是否有效以便我可以加快迭代速度的最快方法是什么?对于长向量,这将决定我的大部分缩放能力。
一些快速而肮脏的东西,但我不确定它是否永远有效:
all(duplicated(x) == c(FALSE,TRUE))
Run Code Online (Sandbox Code Playgroud)
这是基于这样一个事实:两个相同的值总是彼此相邻,一个不重复,下一个重复。似乎适用于测试集:
x <- c("A", "F", "J", "E", "F", "A", "J", "E")
s1 <- c("A", "A", "J", "J", "E", "E", "F", "F")
s2 <- c("J", "J", "A", "A", "F", "F", "E", "E")
all(duplicated(x) == c(FALSE,TRUE))
#[1] FALSE
all(duplicated(s1) == c(FALSE,TRUE))
#[1] TRUE
all(duplicated(s2) == c(FALSE,TRUE))
#[1] TRUE
Run Code Online (Sandbox Code Playgroud)
而且速度非常快,在我的机器上只需百分之五秒就可以浏览一百万个长度的向量:
x <- rep(1:1e6, each=2)
system.time(all(duplicated(x) == c(FALSE,TRUE)))
# user system elapsed
# 0.04 0.00 0.05
Run Code Online (Sandbox Code Playgroud)
一个选项涉及将 转换为两行矩阵vector(因为lengthis并且元素恰好出现两次),获取并测试行数是否为 1。如果重复的值相邻,则在添加属性时,第二个行将与第一行完全相同evenuniquedimmatrix
f1 <- function(x)
{
nrow(unique(matrix(x, nrow = 2))) == 1
}
Run Code Online (Sandbox Code Playgroud)
-测试
> v1 <- c("A", "F", "J", "E", "F", "A", "J", "E")
> v2 <- c("A", "A", "J", "J", "E", "E", "F", "F")
> v3 <- c("J", "J", "A", "A", "F", "F", "E", "E")
> f1(v1)
[1] FALSE
> f1(v2)
[1] TRUE
> f1(v3)
[1] TRUE
Run Code Online (Sandbox Code Playgroud)
或者稍微快一点
f2 <- function(x)
{
sum(duplicated(matrix(x, nrow = 2))) == 1
}
Run Code Online (Sandbox Code Playgroud)
-测试
> f2(v1)
[1] FALSE
> f2(v2)
[1] TRUE
> f2(v3)
[1] TRUE
Run Code Online (Sandbox Code Playgroud)
- 基准测试
#thelatemail
> f3 <- function(x) all(duplicated(x) == c(FALSE,TRUE))
#TarJae
> f4 <- function(x) {rle_obj <- rle(x); all(rle_obj$lengths > 1)}
> x1 <- rep(1:1e8, each = 2)
> system.time(f1(x1))
user system elapsed
2.649 0.456 3.111
> system.time(f2(x1))
user system elapsed
2.258 0.433 2.694
> system.time(f3(x1))
user system elapsed
9.972 1.272 11.233
> system.time(f4(x1))
user system elapsed
7.051 3.281 10.333
Run Code Online (Sandbox Code Playgroud)
另一种选择是使用rle函数:
v1 <- c("A", "F", "J", "E", "F", "A", "J", "E")
v2 <- c("A", "A", "J", "J", "E", "E", "F", "F")
v3 <- c("J", "J", "A", "A", "F", "F", "E", "E")
rle_obj <- rle(v3)
all(rle_obj$lengths > 1)
Run Code Online (Sandbox Code Playgroud)
测试:
> rle_obj <- rle(v1)
> all(rle_obj$lengths > 1)
[1] FALSE
> rle_obj <- rle(v2)
> all(rle_obj$lengths > 1)
[1] TRUE
> rle_obj <- rle(v3)
> all(rle_obj$lengths > 1)
[1] TRUE
>
Run Code Online (Sandbox Code Playgroud)