r - 使用 "gap tolerance"对顺序值进行分组

Question

我有这个 df :

FRAME   TRACK_ID   SUM   TC_17
1       15         0     1
2       15         0     1
3       15         0     1
4       15         0     -1
5       15         0     1
6       15         0     1
7       15         0     -1
8       15         0     -1
9       15         0     1
10      15         0     1

现在我使用此代码来获取 TC_17 具有值 1 的帧:

for (i in 1:length(IDs)) {
  temp <- get(paste("TRACK_", IDs[i], sep = ""))
  temp3 <- paste("TRACK_", IDs[i], sep = "")
  if (ncol(temp)==3) {
    print(paste("No contacts detected for Track", IDs[i]))
    next
  }
  for (j in 4:ncol(temp)) {
    contact <- which(temp[,j] == 1) - 1
    contact <- sort(contact)
    Contact_No <- cumsum(c(1, abs(contact[-length(contact)] - contact[-1]) > 1))
    temp2 <- by(contact, Contact_No, identity)
  }
  assign(paste(temp3, colnames(temp)[j], sep = "_"), temp2)
}

这将返回列表 TRACK_15_TC_17 :

Contact_No: 1
[1] 1 2 3
-------------------------------------------------------------------------------- 
Contact_No: 2
[1] 5 6
-------------------------------------------------------------------------------- 
Contact_No: 3
[1] 9 10

到目前为止一切顺利，但我希望这段代码能够包含某种 1 帧的间隙容差。所以最终的列表看起来像这样:

Contact_No: 1
[1] 1 2 3 5 6 
-------------------------------------------------------------------------------- 
Contact_No: 2
[1] 9 10

Contact_No 1 和前 Contact_No 2 已合并在一起，因为 Contact_No 1 的最后一个值和前 Contact_No 2 的第一个值之间只有大小为 1 的差距。我尝试了一些类似的方法:

for (k in 1:length(temp2)) {
  if (k+1>length(temp2)) {
    next
  }
  if ((temp2[[k]][length(temp2[[k]])])-(temp2[[k+1]][1])<=1 & (k+1) < length(temp2)) {
    ListTemp <- c(temp2[[k]][length(temp2[[k]])], temp2[[k+1]])
    print(ListTemp)
  }
}

但是，这似乎不起作用。如果有人可以帮助我，我将不胜感激! (我也对完全不同的方法持开放态度)

Answer 1

一种方法是使用 rle , 找出只有 1 -1 的地方，将其替换为 1，使用 rep 获取新值并根据 diff 不为 1(即连续值)进行拆分，即

i1 <- rle(df$TC_17)

#Run Length Encoding
#  lengths: int [1:5] 3 1 2 2 2
#  values : int [1:5] 1 -1 1 -1 1

i1$values[which(i1$lengths == 1 & i1$values == -1)] <- 1

#Run Length Encoding
#  lengths: int [1:5] 3 1 2 2 2
#  values : num [1:5] 1 1 1 -1 1

i2 <- which(rep(i1$values, i1$lengths) == 1)
#[1]  1  2  3  4  5  6  9 10


split(i2, cumsum(c(TRUE, diff(i2) != 1)))
#$`1`
#[1] 1 2 3 4 5 6

#$`2`
#[1]  9 10