给定一个0/1向量和一个k值
x <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1)
k <- 3
我需要定义一个函数 f，使得
f(x, k)
[1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
也就是说，如果x的任何一个值为1，则将下一个k=3个x的值设置为零
我用这个可怕的解决方案解决了这个问题。
f <- function(x, k){
.f <- function(x, i, k){
s <- seq(i+1, i+k)
if (x[[i]] == 1) x[s] <- 0
x
}
n <- length(x)
for ( i in seq(1, n-1)) {
#for ( i in seq(1, n-k-1)) {
x <- .f(x, i , k)
}
length(x) <- n
x
}
有人可以提供更加优雅（功能）的解决方案吗？
感谢任何帮助。
foo <- function(x, k) {
n <- length(x)
for (i in seq_along(x)) {
if (x[i] == 1) x[seq(i+1L, min(i+k, n))] <- 0
}
x
}
foo(x, k)
# [1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
当遇到 1 时，这将采取更大的步长，至少对于大的 k 来说应该更有效率。
foo2 <- function(x, k) {
n <- length(x)
i <- 1L
while (i < n) {
if (x[i] == 1) {
x[seq(i+1L, min(i+k, n))] <- 0
i <- i+k
} else {
i <- i+1L
}
}
x
}
foo2 <- function(x, k) {lapply(seq_along(x), function(i) {if (x[i] == 1) x[seq(i+1L, min(i+3L, length(x)))] <<- 0}); x}。 - rawrfnew <- function(x, k){
counter <- 0L
for (i in 1:length(x)){
if (x[i] & !counter) {
counter <- k
next
}
if (!!counter) {
x[i] <- 0
counter <- counter - 1L
}
}
x
}
fnew(x,3)
[1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
简单循环的优点是它可以轻松转换为C++：
Rcpp::cppFunction('
NumericVector fcpp(NumericVector x, int k) {
int n = x.size();
int i;
int counter = 0;
NumericVector xout(n);
xout = x;
for (i = 0;i<n;i++){
if ((x[i]==1) & (counter==0)) {
counter = k;
} else
if (counter > 0) {
xout[i] = 0;
counter += -1;
}
}
return xout;
}')
我发现比较各种不同方案的性能很有趣，这表明简单循环仍然可以发挥作用：
x <- rnorm(1e3)>0
microbenchmark::microbenchmark(f(x,3),gen_vec(x,3),foo(x,3),onePeriodic(x,3),fnew(x,3),fA5C1(x,3),fcpp(x,3))
Unit: microseconds
expr min lq mean median uq max neval cld
f(x, 3) 7783.375 8205.9390 9340.76417 8559.7845 8868.092 33439.139 100 e
gen_vec(x, 3) 2821.330 3086.5605 3683.71671 3176.2015 3490.867 25794.430 100 d
foo(x, 3) 1396.922 1495.1775 1689.60223 1532.5110 1640.818 5901.121 100 c
onePeriodic(x, 3) 879.178 994.0510 1090.42763 1049.4345 1103.793 2109.536 100 bc
fnew(x, 3) 413.538 452.7175 492.22530 473.6405 494.564 1142.563 100 ab
fA5C1(x, 3) 160.000 178.4620 274.42453 188.7180 213.949 7361.222 100 a
fcpp(x, 3) 6.154 16.4100 21.46069 20.5130 24.206 94.359 100 a
Waldi的fcpp函数非常好，但如果您想坚持使用基本 R，可以尝试使用这个for循环。
f <- function(x, y) {
l <- length(x)
x <- as.integer(x)
ind <- which(as.logical(x))
for (i in seq_along(ind)) {
if (x[ind[i]] == 1L) {
x[ind[i] + seq.int(y)] <- 0L
}
}
x[1:l]
}
f(x, 3)
# [1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
onePeriodic <- function(x, k) {
w <- which(x==1L)
idx <- unlist(lapply(split(w, c(0L, cumsum(diff(w) > k+1L))), function(v) {
seq(v[1L], v[length(v)], by=k+1L)
}))
replace(integer(length(x)), idx, 1L)
}
k <- 3
(x <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1))
(o <- onePeriodic(x, k))
输出：
x: [1] 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 0 1 1
o: [1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1
我不知道你为什么特别寻找函数式编程的解决方案，但是，不声明解决方案质量的情况下，这个可以胜任：
x <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1)
gen_vec <- function(x,k){
x2 <- x
purrr::walk(1:length(x2), function(n,k){
ifelse(x2[n]==1, x2[(n+1):min(n+k, length(x2))] <<- 0, x2[n])
}, k=k)
x2
}
输出
> gen_vec(x, 3)
[1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
原始的x未被修改：
> x
[1] 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1
x[3] == 1，因此x[4:6]应该结果为0。但是结果中第六个值是1。这是有意为之吗？这个规则只适用于在f中没有被消除的1吗？ - Bernhardx来说，纯函数式解决方案可能不是最佳选择。 - Bernhard