识别数据框中每个 id 的值的开始和结束时间

Question

这与我之前的 question 有关识别每个 id 的数据帧中的值的出现有关。这次我试图识别每个 id 长度为 4 或更多的连续测量值。

例如

下面是长度为4的w连续出现的例子

 id t1 t2 t3 t4 t5 t6
 1  s  s  w  w  w  w  

对于相同的 id，长度为 4 的 w 连续出现以及最后一个 w 之后出现 4 次非 w 的示例

  id   t3 t4 t5 t6 t7 t8 t9 t10
   1    w  w  w  w  r  s  s  s

我想将其保存在 df 中：

 id t1 t2 t3 t4 t5 t6 t7 t8 t9 t10
  1  s  s  w        w  r  s  s  s

我的数据集有和没有连续出现 w 的格式：

    id t1 t2 t3 t4 t5 t6 t7 t8 t9 t10
    1  s  s  w  w  w  w  r  s  s  s #after t2 value there are 4 occ. of w and after t6 (last one) there are 4 non-w occ.      
    2  s  w  w  w  e  w  w  s  t  v  #no 4 consecutive w occurrence and no 4 non-w occurrence after t7
    3  w  w  w  w  w  d  s  s  s  r #5 occ. of w after t5
    4  e  w  w  w  w  w  w  w  w  w #9 occ. of w after t1
    5  w  e  w  w  w  w  r  r  r  r #4 occ. of w after t2 and 4 occ. of non-w after t6
    6  w  s  w  r  w  r  w  w  s  w #no 4 consecutive w occurance

输出：

id t1 t2 t3 t4 t5 t6 t7 t8 t9 t10
1   s  s  w       w  r  s  s  s
3              w  d  s  s  s  r 
4   e  w
5                 w  r  r   r  r

如何将此格式拆分为 2 个 df，一个带有开始值，一个带有结束值？

例如

df1:

  id t1 t2 t3 
   1  s  s  w  

以及 id2、id3 的其他起始案例...

df2:

id   t6 t7 t8 t9 t10
1     w  r  s  s  s

以及 id2、id3 的其他终端情况...

样本数据：

df<-structure(list(id=c(1,2,3,4,5,6), t1=c("s","s","w","e","w","w"), t2=c("s","w","w","w","e","s"),t3 = c("w","w","w","w","w","w"),
                        t4 = c("w","w","w","w","w","r"), t5 = c("w","e","w","w","w","w"), t6 = c("w","w","d","w","w","r"),
                       t7= c("r","w","s","w","r","w"), t8 = c("s","s","s","w","r","w"), t9=c("s","t","s","w","r","s"), t10=c("s","v","r","w","r","w")), row.names = c(NA, 6L), class = "data.frame")
    

根据 w 标识起点和终点的代码：

Start（不工作连续时间步）：

df1 <- df
df1[-1] <- t(apply(df[-1], 1, function(x) replace(x, seq_along(x) > match('w', x), '')))
df1<-df1[rowSums(df1 == 'w')!=0,  ,drop = FALSE]

End（连续时间步不工作）：

df2 <- df
df2[-1] <- t(apply(df[-1], 1, function(x) replace(x, seq_along(x) <= match('w', x), '')))

df2 <- df2[c(TRUE, colSums(df2[-2] != '') > 0)]
df2<-df2[rowSums(df2 == 'w')!=0,  ,drop = FALSE]

Answer 1

对于多部分问题的第 1 部分，这里有一个解决方案：

myfunc <- function(s, len = 4, what = "w") {
  r <- rle(s)
  rlen <- length(r$values)
  for (ind in rev(seq_len(rlen))) {
    if (r$values[ind] != what) next
    if (r$lengths[ind] < len) next
    r$values <- c(
      if (ind > 1) r$values[1:(ind - 1L)],
      r$values[ind], "", r$values[ind],
      if (ind < rlen) r$values[(ind + 1L):rlen])
    r$lengths <- c(
      if (ind > 1) r$lengths[1:(ind - 1L)],
      1L, r$lengths[ind] - 2L, 1L,
      if (ind < rlen) r$lengths[(ind + 1L):rlen])
  }
  rlen <- length(r$values)
  if (r$lengths[1] == 1L && r$values[1] == what &&
        rlen > 1 && r$values[2] == "") {
    r$values[1] <- ""
  }
  if (r$lengths[rlen] == 1 && r$values[rlen] == what &&
        rlen > 1 && r$values[rlen-1] == "") {
    r$values[rlen] <- ""
  }
  inverse.rle(r)
}

将此应用于每一行（sans id）：

out <- cbind(df[,1,drop=F], t(apply(df[,-1], 1, myfunc)))
colnames(out)[-1] <- colnames(df)[-1]
out
#   id t1 t2 t3 t4 t5 t6 t7 t8 t9 t10
# 1  1  s  s  w        w  r  s  s   s
# 2  2  s  w  w  w  e  w  w  s  t   v
# 3  3              w  d  s  s  s   r
# 4  4  e  w                         
# 5  5  w  e  w        w  r  r  r   r
# 6  6  w  s  w  r  w  r  w  w  s   w

与您的预期输出比较：

id t1 t2 t3 t4 t5 t6 t7 t8 t9 t10
1   s  s  w       w  r  s  s  s
3              w  d  s  s  s  r 
4   e  w
5                 w  r  r  r  r

区别：

• 我的第 5 行保持领先 w e w，因为您的条件中没有任何规则表明需要减少它。

---

让我们深入研究一行数据以了解发生了什么。

unlist(df[5,-1])
#  t1  t2  t3  t4  t5  t6  t7  t8  t9 t10 
# "w" "e" "w" "w" "w" "w" "r" "r" "r" "r" 

myfunc( unlist(df[5,-1]) )

  r <- rle(s)
r
# Run Length Encoding
#   lengths: Named int [1:4] 1 1 4 4
#   values : Named chr [1:4] "w" "e" "w" "r"

（为简洁起见，我在此处删除了 R 的 attr 属性。）这表示有四个不同的序列。首先是 1 个“w”，然后是 1 个“e”，然后是 4 个“w”，然后是 4 个“r”。我们现在将遍历它们中的每一个，如果它们满足我们的约束（匹配what 长度len），那么我们替换values 和lengths。

但是我们需要向后做，这样下一个ind 值（迭代每个向量的索引）没有移动。因此，rev(...) 在 for 循环内。

  rlen <- length(r$values)

ind <- 4 # look at the last value/length first
    if (r$values[ind] != what) next

ind <- 3
    if (r$values[ind] != what) next # nope, keep going
    if (r$lengths[ind] < len) next  # nope, keep going

此时，由于我们通过了两个if 语句，我们现在需要将$values 和$lengths 替换为[ind]：

• r$values[3]（"w"）的旧值需要替换为c("w", "", "w")，表示第一个值，所有中间值，最后一个值；
• r$lengths[3]（这里是4）的旧长度需要替换为c(1, 4-2, 1)，其中第一个1对应新值先"w"； 4-2 对应于新的""；第二个1 是替换向量中的第二个"w"

新向量中的if (...) 使我们能够正确处理ind==1 或ind==rlen，其中[1-1] 和[rlen+1] 不会做我们想做的事情。

好的，让我们跳出循环，我们已经替换了值。 r的当前状态是：

r
# Run Length Encoding
#   lengths: Named int [1:6] 1 1 1 2 1 4
#   values : Named chr [1:6] "w" "e" "w" "" "w" "r"

（attr 已删除。）注意更改：1 w、1 e、1 w、2 ""、1 w、4 r。

让我们继续，以替换第一个或最后一个"w"：

  rlen <- length(r$values) # because it may have changed
  if (r$lengths[1] == 1L && r$values[1] == what &&
        rlen > 1 && r$values[2] == "") {
    r$values[1] <- ""
  }

通常，如果我们以 4 个或更多 "w" 开头，则 t1 将是 "w"，t2 将是 ""，等等。在您的预期输出中，您希望删除前导 "w" , 所以 4 部分的if 子句是看这个条件是否存在，并相应地删除它。 （r$values[1:2] 现在相同的事实并不重要。）

类似于向量的结尾。

在这种情况下，它不满足任何一个条件，因此r 与后for-loop 保持不变。

最后，我们调用inverse.rle，它接受数字和计数并转换回向量。

  inverse.rle(r)
#  [1] "w" "e" "w" ""  ""  "w" "r" "r" "r" "r"

### perfectly equivalent to
rep(r$values, times = r$lengths)
#  t1  t2  t6          t6 t10 t10 t10 t10 
# "w" "e" "w"  ""  "" "w" "r" "r" "r" "r" 

（其实inverse.rle使用rep.int，比rep快一点，但功能较少。）