R：查找时间序列中连续（neg，neg，neg）数字的每个序列答案

【问题标题】：R: find every sequence of consecutive (neg,neg,neg) numbers in timeseriesR：查找时间序列中连续（neg，neg，neg）数字的每个序列
【发布时间】：2021-02-18 20:04:33
【问题描述】：

我找不到解决这个问题的方法：对于我的数据框的每一列，我需要找到并放入一个新的数据框，所有负三元组（连续负值的序列）和单个值（或者正或负）按时间顺序跟在三连音之后。例如，在 TSL 列中，我需要保留值 -4、-1、-3、1 和相关日期。我在 R 方面不是很资深，所以我花了相当多的时间试图找出不同的策略：for 循环和嵌套 ifs，dplyr 和 quantmod 用于时间序列和滞后。到目前为止，我一直没有成功。谁能指出我正确的方向？谢谢

<table>
<thead>
<tr>
<th>Date</th>
<th>TSL</th>
<th>FAS</th>
<th>GMV</th>
</tr>
<tr>
<th>2019-01-03</th>
<th>-3</th>
<th>-1</th>
<th>-4</th>
<tr>
<th>2019-01-04</th>
<th>5</th>
<th>3</th>
<th>3</th>
</tr><tr>
<th>2019-01-07</th>
<th>5</th>
<th>2</th>
<th>3</th>
</tr><tr>
<th>2019-01-08</th>
<th>0</th>
<th>0</th>
<th>1</th>
</tr><tr>
<th>2019-01-09</th>
<th>0</th>
<th>4</th>
<th>1</th>
</tr><tr>
<th>2019-01-10</th>
<th>1</th>
<th>-0</th>
<th>-1</th>
</tr><tr>
<th>2019-01-11</th>
<th>0</th>
<th>1</th>
<th>7</th>
</tr><tr>
<th>2019-01-14</th>
<th>-3</th>
<th>1</th>
<th>1</th>
</tr><tr>
<th>2019-01-15</th>
<th>2</th>
<th>-1</th>
<th>-0</th>
</tr><tr>
<th>2019-01-16</th>
<th>0</th>
<th>-6</th>
<th>0</th>
</tr><tr>
<th>2019-01-17</th>
<th>0</th>
<th>0</th>
<th>1</th>
</tr><tr>
<th>2019-01-18</th>
<th>-4</th>
<th>2</th>
<th>0</th>
</tr><tr>
<th>2019-01-22</th>
<th>-1</th>
<th>-0</th>
<th>-1</th>
</tr><tr>
<th>2019-01-23</th>
<th>-3</th>
<th>-1</th>
<th>-1</th>
</tr><tr>
<th>2019-01-24</th>
<th>1</th>
<th>3</th>
<th>1</th>
</tr>
</thead>
<tbody>
</tbody>
</table>

数据

structure(list(Date = structure(c(17899, 17900, 17903, 17904, 17905, 17906, 17907, 17910, 17911, 17912, 17913, 17914, 17918, 17919, 17920), class = "Date"), TSL = c(-3L, 5L, 5L, 0L, 0L, 1L, 0L, -3L, 2L, 0L, 0L, -4L, -1L, -3L, 1L), FAS = c(-1L, 3L, 2L, 0L, 4L, 0L, 1L, 1L, -1L, -6L, 0L, 2L, 0L, -1L, 3L), GMV = c(-4L, 3L, 3L, 1L, 1L, -1L, 7L, 1L, 0L, 0L, 1L, 0L, -1L, -1L, 1L)), class = "data.frame", row.names = c(NA, -15L))

【问题讨论】：

您能否以一种我们无需解析 HTML 即可使用的方式粘贴您的数据？ dput(x) 的输出通常很棒。
（我建议进行编辑，以明确的格式包含该示例数据。如果您不喜欢这样，我很抱歉，请随时回滚或删除它。）
非常感谢 r2evans 和 @Jordan 的建议，我花了一些时间研究这两者并提出了一个完全符合我需求的解决方案。可能效率不高（但它捕获了所有的三元组），无论如何：get_sets = 3 & rlesx$values == -1) ind

标签： r algorithm sequence

【解决方案1】：

试试这个：

(starts <- lapply(dat[,-1], function(z) zoo::rollapply(z, 4, FUN = function(y) length(y) == 4L && all(y[1:3] < 0) && y[4] > 0, partial = TRUE, align = "left")))
# $TSL
#  [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE
# $FAS
#  [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
# $GMV
#  [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
(use <- lapply(starts, function(z) zoo::rollapply(z, 4, FUN = any, align = "right", partial = TRUE)))
# $TSL
#  [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE  TRUE
# $FAS
#  [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
# $GMV
#  [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
lapply(use, function(ind) dat[ind,])
# $TSL
#          Date TSL FAS GMV
# 12 2019-01-18  -4   2   0
# 13 2019-01-22  -1   0  -1
# 14 2019-01-23  -3  -1  -1
# 15 2019-01-24   1   3   1
# $FAS
# [1] Date TSL  FAS  GMV 
# <0 rows> (or 0-length row.names)
# $GMV
# [1] Date TSL  FAS  GMV 
# <0 rows> (or 0-length row.names)

我上面的代码的工作方式：

第一个 zoo::rollapply 执行滚动窗口操作，一次查看 4 个：位置 1-4，然后是 2-5，然后是 3-6，然后是 4-7，依此类推，在传递的向量中。在第一列中，它终于看到了-4, -1, -3，然后是1，内部匿名函数中的逻辑通过并为该位置返回一个TRUE。这会生成上面列出的starts，它表示 3-neg 和 1-pos 序列的第一行。
第二个zoo::rollapply 扩展了所需的长度。（也许可以将它们合并到一个调用中。）
我将其中的每一个包装到lapply 中，以便对每一列进行计算； lapply(dat[,-1], ...) 正在为除第一 (Date) 列之外的所有列执行此操作。
最后，最后一个 lapply 只是将数据子集化为一个包含三个帧的列表，每个帧都包含序列。

【讨论】：

【解决方案2】：

所有在基础 R 中

这使用与 base::rle 类似的逻辑。我们可以获取该值的sign()，以确定它是正数（1）还是负数-1（sign() 将0 重新编码为0）。然后，我们可以通过上下移动仍然相等的数字来检查我们有多少重复值。

从那里我们可以获得第一个三元组（需要对多个匹配进行增强）并创建一个合适的位置向量以从我们的日期和 4 个数字中提取。

我不太确定您希望最终的 data.frame 是什么样子，所以我没有包含它。

# Recreating data frame
dx <- c(17899,17900, 17903, 17904, 17905, 17906, 17907, 17910, 17911, 17912,
        17913, 17914, 17918, 17919, 17920)

df <- data.frame(
  Date = as.Date(dx, origin = "1970-01-01"),
  TSL = c(-3L, 5L, 5L, 0L, 0L, 1L, 0L, -3L, 2L, 0L, 0L, -4L, -1L, -3L, 1L),
  FAS = c(-1L, 3L, 2L, 0L, 4L, 0L, 1L, 1L, -1L, -6L, 0L, 2L, 0L, -1L, 3L),
  GMV = c(-4L, 3L, 3L, 1L, 1L, -1L, 7L, 1L, 0L, 0L, 1L, 0L, -1L, -1L, 1L)
)


df2 <- data.frame(
  Date = as.Date(dx, origin = "1970-01-01"),
  TSL = c(-3L, 5L, 5L, 0L, 0L, 1L, 0L, -3L, 2L, 0L, 0L, -4L, -1L, -3L, 1L),
  FAS = c(-1L, 3L, 2L, 0L, 4L, 0L, 1L, -1L, -1L, -6L, 0L, -2L, 0L, -1L, 3L),
  GMV = c(-4L, -3L, -3L, 1L, 1L, -1L, -7L, -1L, 0L, 0L, 1L, 0L, -1L, -1L, 1L)
)

x <- df2[[3]]

# adapted from base::rle
get_sets <- function(x, dates) {
  n <- length(x)
  sx <- sign(x)
  y <- sx[-1L] != sx[-n]
  i <- c(which(y | is.na(y)), n)
  res <- diff(c(0L, i))
  # w is where the FIRST triplet is found
  w <- which(res >= 3 & sx[1] == -1)[1]
  
  # Check if any are found
  if (anyNA(w)) {
    return(list(dates = NULL, set = NULL))
  }
  
  ind <- sum(res[seq.int(0, w - 1L)]) + 1
  inds <- seq.int(ind, ind + 3)
  list(
    dates = dates[inds],
    set = x[inds]
  )
}

# Applying to each column
lapply(df[, 2:4], get_sets, dates = df$Date)
#> $TSL
#> $TSL$dates
#> [1] "2019-01-18" "2019-01-22" "2019-01-23" "2019-01-24"
#> 
#> $TSL$set
#> [1] -4 -1 -3  1
#> 
#> 
#> $FAS
#> $FAS$dates
#> NULL
#> 
#> $FAS$set
#> NULL
#> 
#> 
#> $GMV
#> $GMV$dates
#> [1] "2019-01-04" "2019-01-07" "2019-01-08" "2019-01-09"
#> 
#> $GMV$set
#> [1] 3 3 1 1
lapply(df2[, 2:4], get_sets, dates = df2$Date)
#> $TSL
#> $TSL$dates
#> [1] "2019-01-18" "2019-01-22" "2019-01-23" "2019-01-24"
#> 
#> $TSL$set
#> [1] -4 -1 -3  1
#> 
#> 
#> $FAS
#> $FAS$dates
#> [1] "2019-01-14" "2019-01-15" "2019-01-16" "2019-01-17"
#> 
#> $FAS$set
#> [1] -1 -1 -6  0
#> 
#> 
#> $GMV
#> $GMV$dates
#> [1] "2019-01-03" "2019-01-04" "2019-01-07" "2019-01-08"
#> 
#> $GMV$set
#> [1] -4 -3 -3  1

^{由reprex package (v1.0.0) 于 2021-02-18 创建}

【讨论】：