R 填写两个指定值之间的所有条目

我有一个很长的向量，数千个条目，其中零散地包含元素0，1，2。0表示“无信号”，1表示“信号开启”，2表示“信号关闭”。我试图找到从1到下一次出现的2的运行，并用1填充空间。我还需要在2和下一个出现的1之间做同样的事情，但是用0填充空间

我目前有一个使用循环解决此问题的解决方案，但速度慢且效率极低：

示例向量：

exp=c（1,1,1,0,0,1,2,0,2,0,1,0,2）

预期结果：

1,1,1,1,1,1,1,2,0,0,0,1,1,2

---

谢谢

您可以使用数据表中的

rle

和

shift

，方法如下：

library(data.table)

# create the run-length object
rl <- rle(x)

# create indexes of the spots in the run-length object that need to be replaced
idx1 <- rl$values == 0 & shift(rl$values, fill = 0) == 1 & shift(rl$values, fill = 0, type = 'lead') %in% 1:2
idx0 <- rl$values == 2 & shift(rl$values, fill = 0) == 0 & shift(rl$values, fill = 2, type = 'lead') %in% 0:1

# replace these values
rl$values[idx1] <- 1
rl$values[idx0] <- 0

作为

shift

-功能的替代，您还可以使用dplyr中的

lag

和

lead

功能

---

如果您想评估这两种方法的速度，microbenchmark-包是一个有用的工具。下面您将看到3个基准，每个基准都有不同的向量大小：

# create functions for both approaches
jaap <- function(x) {
  rl <- rle(x)

  idx1 <- rl$values == 0 & shift(rl$values, fill = 0) == 1 & shift(rl$values, fill = 0, type = 'lead') %in% 1:2
  idx0 <- rl$values == 2 & shift(rl$values, fill = 0) == 0 & shift(rl$values, fill = 2, type = 'lead') %in% 0:1

  rl$values[idx1] <- 1
  rl$values[idx0] <- 0

  inverse.rle(rl)
}

john <- function(x) {
  Reduce(f, x, 0, accumulate = TRUE)[-1]
}

#为两种方法创建函数
jaap您还可以通过以下功能使用
Reduce
：

f <- function(x,y){
  if(x == 1){
    if(y == 2) 2 else 1
  }else{
    if(y == 1) 1 else 0
  }
}

fx减少（f，x，0，累计=TRUE）[-1]
[1] 1 1 1 1 1 1 2 0 0 0 1 1 2
完美！欠你一杯啤酒真是太好了。我怀疑
rle
是相关的，但无法计算出具体的方法。很好的选择，但结果向量的长度不同。您需要将
[-1]
添加到
Reduce
-调用以在开始时删除多余的1（即：
Reduce（f，x，1，acculate=TRUE）[-1]
）。另一点：在
Reduce
调用中，您需要使用
0
来处理向量以零开头的情况。我已经冒昧地解决了这个问题，希望你不介意。@Jaap OP并没有具体说明在这种情况下会发生什么。根据当前状态，有时0变为1，有时保持为0。我最初的解决方案在开始时默认为“信号打开”，您的实际编辑默认为将初始信号视为关闭。可以说，“off”是比“on”更自然的默认值，所以我对您的编辑没意见。对于初始值来说，它是相当不重要的。谢谢@JohnColeman提供的替代方案！它最终会降到我还无法测试的速度。和往常一样，我喜欢这些答案，因为这是一个新的挑战，让直观的解决方案，而不仅仅是复制。非常感谢你们两位！
# benchmark on the original data

> microbenchmark(jaap(x), john(x), times = 100)
Unit: microseconds
    expr    min      lq     mean  median     uq     max neval cld
 jaap(x) 58.766 61.2355 67.99861 63.8755 72.147 143.841   100   b
 john(x) 13.684 14.3175 18.71585 15.7580 23.902  50.705   100  a 

# benchmark on a somewhat larger vector

> x2 <- rep(x, 10)
> microbenchmark(jaap(x2), john(x2), times = 100)
Unit: microseconds
     expr     min      lq      mean   median       uq     max neval cld
 jaap(x2)  69.778  72.802  84.46945  76.9675  87.3015 184.666   100  a 
 john(x2) 116.858 121.058 127.64275 126.1615 130.4515 223.303   100   b

# benchmark on a very larger vector

> x3 <- rep(x, 1e6)
> microbenchmark(jaap(x3), john(x3), times = 20)
Unit: seconds
     expr      min        lq      mean    median        uq       max neval cld
 jaap(x3)  1.30326  1.337878  1.389187  1.391279  1.425186  1.556887    20  a 
 john(x3) 10.51349 10.616632 10.689535 10.670808 10.761191 10.918953    20   b

f <- function(x,y){
  if(x == 1){
    if(y == 2) 2 else 1
  }else{
    if(y == 1) 1 else 0
  }
}

> x <- c(1,1,1,0,0,1,2,0,2,0,1,0,2)
> Reduce(f, x, 0, accumulate = TRUE)[-1]
 [1] 1 1 1 1 1 1 2 0 0 0 1 1 2