R:如何对二进制信号进行滤波/平滑

R:如何对二进制信号进行滤波/平滑,r,R,我有一个表示时间序列的二进制向量。我想过滤掉快速开关,比如0000000 1100000000应该是零,同样地11111111 011111应该是一 什么样的过滤器/函数适合该任务?使用加权平均值考虑相邻值如何?在这种情况下,将考虑每个值的2个邻居(两侧都有2个邻居)。当然,这是可以调整的 > v <- sample(c(0,1),30,replace=TRUE) > v [1] 0 1 1 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1

我有一个表示时间序列的二进制向量。我想过滤掉快速开关,比如0000000 1100000000应该是零,同样地11111111 011111应该是一


什么样的过滤器/函数适合该任务?

使用加权平均值考虑相邻值如何?在这种情况下,将考虑每个值的2个邻居(两侧都有2个邻居)。当然,这是可以调整的

> v <- sample(c(0,1),30,replace=TRUE)

> v
 [1] 0 1 1 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 1 0 0 0

# embed(v,5) is a short version for this:
# cbind(v[1:26],v[2:27],v[3:28],v[4:29],v[5:30])

> m <- embed(v,5)

> c(round(m %*% c(.1,.2,.4,.2,.1)))
 [1] 1 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 1 0 0 0
正如你所看到的,孤独者已经不在了


根据sgibb的建议,整个模糊可以归结为:

round(filter(v, c(.1,.2,.4,.2,.1)))

(但我想上面写出来的版本清楚地说明了要做什么,这就是我为什么不写的原因)

也许这是一种愚蠢的方法,但是
rle
/
相反。rle
似乎是很好的选择。例如,如果将快速切换定义为小于3个相等值的周期:

b1 <- c(rep(0, 7), rep(1, 2), rep(0, 7))
b2 <- c(rep(1, 10), 0, rep(1, 4))

binaryFilter <- function(x, threshold=3) {
  r <- rle(x)
  isBelowThreshold <- r$lengths < threshold
  r$values[isBelowThreshold] <- abs(1-r$values[isBelowThreshold])
  return(inverse.rle(r))
}

binaryFilter(b1)
# [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

binaryFilter(b2)
# [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

b1另一种类似于@sgibb解决方案的解决方案,但使用
zoo
软件包中的
rollapply

  • 找到序列的趋势(优势值)
  • 沿系列以固定窗口宽度滚动应用,如果窗口存在趋势,则采用趋势
  • 代码更容易解释:)


    filter\u bin你如何定义一个“快速开关”?你可以/应该使用
    embed
    来代替你的
    cbind
    调用。我想这和
    round(filter(v,c(.1,2,4,2,1))
    完全一样。
    。哦,该死的-我还以为我发明了这个算法…:/。。。只是开玩笑。再次感谢!那好多了
    b1 <- c(rep(0, 7), rep(1, 2), rep(0, 7))
    b2 <- c(rep(1, 10), 0, rep(1, 4))
    
    binaryFilter <- function(x, threshold=3) {
      r <- rle(x)
      isBelowThreshold <- r$lengths < threshold
      r$values[isBelowThreshold] <- abs(1-r$values[isBelowThreshold])
      return(inverse.rle(r))
    }
    
    binaryFilter(b1)
    # [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    
    binaryFilter(b2)
    # [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    
    filter_bin <-
    function(vec,width =3){
      trend <- 
        as.numeric(names(which.max(table(vec))))
      rollapply(vec,width,function(x) 
      if(trend %in% x) trend else unique(x))
    }
    
      filter_bin(b2)
      ## 1 1 1 1 1 1 1 1 1 1 1 1 1
      filter_bin(b1)
      ## 0 0 0 0 0 0 0 0 0 0 0 0 0 0