如何根据R中另一列的指定范围[移动窗口]中的值增加新列

ergxz8rk 于 2023-07-31 发布在其他

关注(0)|答案(3)|浏览(78)

我想根据另一列的移动窗口范围中的值创建新列。新列中的一个将基于来自另一列中的先前行的移动窗口，而另一列将基于来自另一列中的后续行的移动窗口。
让我们以下面的数据集为例：

dt <- data.frame(A_LM = c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
                          0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0),
                 B_LM = c(1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0,
                          0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1))

字符串
我想创建：

称为“A_LM_corrected”的列检测A_LM中何时有1，并且仅保留在A_LM的最后5个先前行中没有其他1的那些。当满足条件时，它应该由1组成，当不满足条件时，它应该由0组成。
- 具有相同原理但用于列B_LM中的值的称为“B_LM_corrected”的列，
- 被称为“A_LM_foll”的列，其检测1何时存在于A_LM_corrected中，并且仅保持1也存在于B_LM_corrected的接下来的5个后续行中的那些列[检测1何时存在于A_LM_corrected中和B_LM_corrected的5个后续行中的至少一个行中]，以及
具有相同原理的称为“B_LM_foll”的列[检测1何时存在于B_LM_corrected中和A_LM_corrected的5个后续行中的至少1行中]。

理想情况下，最终的 Dataframe 应该是这样的：

dt_aim <- data.frame(A_LM = c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
                              0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0),
                     B_LM = c(1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0,
                              0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1),
                     A_LM_corrected = c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0),
                     B_LM_corrected = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1),
                     A_LM_foll = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                   0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0),
                     B_LM_foll = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                   0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0))

型
我尝试使用tidyverse和data.table来这样做，但我没有设法得到我需要的东西[我甚至离它很远]。
我知道这在Excel中很容易做到：

色谱柱A [A_LM]：单元格A2中的第一个感兴趣值（本例中为0）
色谱柱B [B_LM]：单元格B2中的第一个感兴趣值（本例中为1）
列C [A_LM_corrected]（前5行必须递增，之后只能复制/粘贴）：
C2 = IF（A2 = 1，IF（SUM（A1：A1）> 0，0，A2），A2）
C3 = IF（A3 = 1，IF（SUM（A1：A2）> 0，0，A3），A3）
C4 = IF（A4 = 1，IF（SUM（A1：A3）> 0，0，A4），A4）
C5 = IF（A5 = 1，IF（SUM（A1：A4）> 0，0，A5），A5）
C6 = IF（A6 = 1，IF（SUM（A1：A5）> 0，0，A6），A6）
C7 = IF（A7 = 1，IF（SUM（A2：A6）> 0，0，A7），A7）
C8 = IF（A8 = 1，IF（SUM（A3：A7）> 0，0，A8），A8）
列D [B_LM_corrected]（前5行必须递增，之后只能复制/粘贴）：
D2 = IF（B2 = 1，IF（SUM（B1：B1）> 0，0，B2），B2）
D3 = IF（B3 = 1，IF（SUM（B1：B2）> 0，0，B3），B3）
D4 = IF（B4 = 1，IF（SUM（B1：B3）> 0，0，B4），B4）
D5 = IF（B5 = 1，IF（SUM（B1：B4）> 0，0，B5），B5）
D6 = IF（B6 = 1，IF（SUM（B1：B5）> 0，0，B6），B6）
D7 = IF（B7 = 1，IF（SUM（B2：B6）> 0，0，B7），B7）
D8 = IF（B8 = 1，IF（SUM（B3：B7）> 0，0，B8），B8）
列E [A_LM_foll]（直接复制/粘贴，无需初始手动增量）：
E2 = IF（C2 = 1，IF（SUM（D3：D7）> 0，1，0），0）
列F [B_LM_foll]（直接复制/粘贴，无需初始手动增量）：
F2 = IF（D2 = 1，IF（SUM（C3：C7）> 0，1，0），0）

但我需要让它在R中工作;- ）
欢迎任何帮助：-）

来源：https://stackoverflow.com/questions/76671818/how-to-increment-a-new-column-based-on-values-in-a-specified-range-a-moving-win

3条答案

按热度按时间

zwghvu4y1#

使用zoo的另一种dplyr方法：

library(dplyr)
dt %>%
  mutate(
    across(
      ends_with("_LM"),
      ~ +(. > 0 & zoo::rollapplyr(. < 1, list(-(1:4)), all, partial = TRUE, fill = TRUE)),
      .names = "{.col}_corrected"),
    A_LM_foll = +(A_LM_corrected & zoo::rollapply(B_LM_corrected > 0, list(-1:4), any, partial = TRUE, align = "left")),
    B_LM_foll = +(B_LM_corrected & zoo::rollapply(A_LM_corrected > 0, list(-1:4), any, partial = TRUE, align = "left"))
  )
#    A_LM B_LM A_LM_corrected B_LM_corrected A_LM_foll B_LM_foll
# 1     0    1              0              1         0         1
# 2     0    1              0              0         0         0
# 3     0    0              0              0         0         0
# 4     1    1              1              0         0         0
# 5     0    0              0              0         0         0
# 6     0    0              0              0         0         0
# 7     0    0              0              0         0         0
# 8     0    1              0              0         0         0
# 9     0    0              0              0         0         0
# 10    0    0              0              0         0         0
# 11    1    0              1              0         0         0
# 12    0    0              0              0         0         0
# 13    0    0              0              0         0         0
# 14    0    0              0              0         0         0
# 15    0    0              0              0         0         0
# 16    0    0              0              0         0         0
# 17    0    1              0              1         0         1
# 18    0    0              0              0         0         0
# 19    0    0              0              0         0         0
# 20    0    0              0              0         0         0
# 21    1    0              1              0         1         0
# 22    0    0              0              0         0         0
# 23    1    0              0              0         0         0
# 24    0    0              0              0         0         0
# 25    0    1              0              1         0         0

字符串
非常感谢@G.Grothendieck改进了后两个rollapply，更多的是帮助我理解了list(-(1:4))在第一个rollapplyr中的使用。未来的我：如果width=是一个数字向量，那么它的宽度将应用于每个by=元素，如果它比数据短，它将被回收。但是，如果widths=是list，那么它的值被认为是从当前时间的偏移量，所以当widths=5, align="right"表示从“here”偏移c(-4, -3, -2, -1, 0)时，widths=list(-(1:4)), align="right"表示从“here”偏移c(-4, -3, -2, -1)，忽略第0（第“here”）元素。Mind blown：-）

赞(0）回复(0）举报 2023-07-31

sulc1iza2#

下面是使用tidyverse的一种可能性。
特别地，我使用函数map_dbl创建帮助变量A_LM_back和B_LM_back来检查前五行。

dt %>% 
  mutate(
    A_LM_back = map_dbl(1:n(), \(k) max(0, A_LM[pmax(k-1:5, 0)])),
    B_LM_back = map_dbl(1:n(), \(k) max(0, B_LM[pmax(k-1:5, 0)])),
  ) %>% 
  mutate(
    A_LM_cor = if_else(A_LM == 1 & A_LM_back == 0, 1, 0),
    B_LM_cor = if_else(B_LM == 1 & B_LM_back == 0, 1, 0),
  ) %>%
  mutate(
    A_LM_next = map_dbl(1:n(), \(k) max(A_LM_cor[pmin(k+1:5, nrow(dt))])),
    B_LM_next = map_dbl(1:n(), \(k) max(B_LM_cor[pmin(k+1:5, nrow(dt))])),
  ) %>% 
  mutate(
    A_LM_foll = if_else(A_LM_cor == 1 & B_LM_next == 1, 1, 0),
    B_LM_foll = if_else(B_LM_cor == 1 & A_LM_next == 1, 1, 0),
  )

字符串

赞(0）回复(0）举报 2023-07-31

ovfsdjhp3#

这里有一个data.table方法。frollsum()取向量的滚动和。在向量开始之前，它以一种稍微令人惊讶的方式工作：

x <- 1:10
SHIFT <- 5
frollsum(x, n = SHIFT, fill = 0)
#  [1]  0  0  0  0 15 20 25 30 35 40

字符串
我希望它返回第一个n数字的三角形数字，然后以n的恒定速率增加。然而，第一个n数字的值为fill。如果您不提供fill，则它们将是NA。要获得从第一个索引开始的三角形数，你需要这样做，我觉得有点尴尬：

frollsum(c(rep(0, SHIFT), x), SHIFT)[(SHIFT + 1):(length(x) + SHIFT)]
#  [1]  1  3  6 10 15 20 25 30 35 40

型
不过我觉得这个应该还是比较快的。

library(data.table)
setDT(dt)
sd_cols <- c("A_LM", "B_LM")
SHIFT <- 5

dt[,
    (sprintf("%s_corrected", sd_cols)) := lapply(
        .SD,
        \(x) as.numeric(x == 1 & frollsum(c(rep(0, SHIFT), shift(x)), SHIFT, na.rm = TRUE)[(SHIFT + 1):(.N + SHIFT)] == 0)
    ),
    .SDcols = sd_cols
]

dt[, A_LM_foll := as.numeric(
    A_LM_corrected == 1 & frollsum(c(B_LM_corrected, rep(0, SHIFT)), SHIFT, align = "left", na.rm = TRUE)[1:.N] > 0
)]

dt[, B_LM_foll := as.numeric(
    B_LM_corrected == 1 & frollsum(c(A_LM_corrected, rep(0, SHIFT)), SHIFT, align = "left", na.rm = TRUE)[1:.N] > 0
)]

identical(dt, dt_aim) # TRUE

型

赞(0）回复(0）举报 2023-07-31

我来回答

如何根据R中另一列的指定范围[移动窗口]中的值增加新列

3条答案

相关问题

热门标签

最新问答