R中的所有不同函数,在循环中应用它?
我有一个数字向量。例如,像这样,只有几个唯一的值:R中的所有不同函数,在循环中应用它?,r,for-loop,unique,distinct,difference,R,For Loop,Unique,Distinct,Difference,我有一个数字向量。例如,像这样,只有几个唯一的值: set.seed(2) a = rpois(1000, 0.3) head(a, 20) #### [1] 0 0 0 0 1 1 0 1 0 0 0 0 1 0 0 1 2 0 0 0 现在我需要的是找到每个数字,如果它本身,前面和后面的元素都是不同的。我试图在R中找到一个完全不同或完全不同的函数,但没有成功,所以我做了: all.diff = function(num) NROW(unique(num))==NROW(num) 然后我为
set.seed(2)
a = rpois(1000, 0.3)
head(a, 20)
#### [1] 0 0 0 0 1 1 0 1 0 0 0 0 1 0 0 1 2 0 0 0
现在我需要的是找到每个数字,如果它本身,前面和后面的元素都是不同的。我试图在R中找到一个完全不同或完全不同的函数,但没有成功,所以我做了:
all.diff = function(num) NROW(unique(num))==NROW(num)
然后我为循环设计了一个,如下所示:
ConsecutiveDifferent = function(vector) {
output = numeric(NROW(vector)-2)
for (i in 2:(NROW(vector)-1) ) {
trio <- c(vector[i-1], vector[i], vector[i+1])
if ( all.diff(trio) ) output[i]<-1
}
return(output)
}
res = ConsecutiveDifferent(a)
head(res, 20)
#### [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0
连续差分=函数(向量){
输出=数值(NROW(矢量)-2)
对于(i/2:(NROW(向量)-1)){
三人组丑陋得像罪一样,但确实有效
set.seed(2)
a <- rpois(1000, 0.3)
a_shifted <- embed(a,3)
indices <- 1 + which(apply(X = a_shifted,
FUN = function(num) {length(unique(num))==length(num)},
MARGIN = 1))
print(a[indices])
set.seed(2)
arle.这对于三人组来说非常特殊:
w = with(rle(a), cumsum(lengths)[
lengths == 1L & c(NA, values[-length(values)]) != c(values[-1], NA)
])
res2 = c(NA, logical(length(a)-2), NA)
res2[w] = TRUE
identical(res, res2) # TRUE
combn.我可以
a_shift = list(c(NA, a[-length(a)]), a, c(a[-1], NA))
n_distinct = rowSums(combn(a_shift, 2, FUN = function(x) x[[1]] != x[[2]]))
res = n_distinct == length(a_shift)
为了检验它是否有效
head(cbind.data.frame(a, res), 20)
a res
1 0 NA
2 0 FALSE
3 0 FALSE
4 0 FALSE
5 1 FALSE
6 1 FALSE
7 0 FALSE
8 1 FALSE
9 0 FALSE
10 0 FALSE
11 0 FALSE
12 0 FALSE
13 1 FALSE
14 0 FALSE
15 0 FALSE
16 1 TRUE
17 2 TRUE
18 0 FALSE
19 0 FALSE
20 0 FALSE
通过扩展a_shift
,这可以扩展到向前和向后看得更远,这可以通过数据中的shift
功能轻松完成。表:
library(data.table)
n_back = 1
n_fwd = 1
a_shift = setDT(list(a))[, c(
shift(V1, n_back:0, type="lag"),
list(shift(V1, n_fwd, type="lead"))
)]
a_shift[, r := .I]
resDT = melt(a_shift, id = "r")[, .(res =
if (any(is.na(value))) NA else uniqueN(value) == n_fwd + n_back + 1L
), by=r][, a := a]
identical(res, resDT$res) # TRUE
…这可能看起来很神秘,但这更多地与我的编码风格有关,而不是与软件包有关。您可以使用duplicated
功能
adjacent_dif <- function(i,l){
as.numeric(!any(duplicated(c(l[i-1], l[i], l[i+1]))))
}
sapply(2:length(a)-1, adjacent_dif, a)
以下步骤不使用迭代器函数(apply-like函数),我认为它会更快
da = diff(a)
lda = c(0,da)
rda = c(da,0)
sda = lda + rda
res = lda != 0 & rda != 0 & sda != 0
res
在第一个和最后一个位置包含FALSE
,它的长度与vectora
相同。不知道为什么要使用NROW。length
是vectors的惯用用法。你是对的,这是一个坏习惯…;-)出于好奇,这些是不是比你原来的代码有很大的改进(我在基准测试中没有看到)?@Frank我的代码实际上是最后一个“Marc”(对不起,我用了我的名字)啊,好吧,让你和下面同名的回答者混在一起了。你可以使用嵌入进行移位。我不熟悉嵌入,但它显然更适合这个目的。修复了。嗯,奇怪的是OP的测试发现这个速度变慢了。我不确定是什么让它变慢了,但最后一步可能是res=(!!lda)*(!!rda)*(!!sda)
或其他什么。即使有1000万长度的向量,它仍然会变慢。但事实上,@frank建议的改进将时间减少了30%,并使此算法N°1。团队合作愉快!