查找先前出现的值并在相反列中获取值

Question

我有这样的数据：

    stim1 stim2 
 1:     2     3               
 2:     1     3                
 3:     2     1             
 4:     1     2            
 5:     3     1          

structure(list(stim1 = c(2L, 1L, 2L, 1L, 3L),
               stim2 = c(3L, 3L, 1L, 2L, 1L)),
          row.names = c(NA, -10L), class = c("data.table", "data.frame"))

我的目标是添加两列：一列用于“stim1”，另一列用于“stim2”。对于两列的每一行，我想在任一列中找到其值的上一次出现，然后在相反的列中获取值。

例如，第 3 行的“stim1”为 2。之前出现的 2 在第 1 行的“stim1”中。该行另一列的值为 3。所以Prev1[3] 为 3。

另一个例子：在第 4 行，'stim1' 为 1。之前出现的 1 在第 3 行的'stim2'中。该行另一列中的值为 2。所以Prev1[4] 为 2。

期望的输出：

    stim1 stim2       Prev1  Prev2  
 1:     2     3       <NaN>  <NaN>         
 2:     1     3       <NaN>    2          
 3:     2     1         3      3
 4:     1     2         2      1
 5:     3     1         1      2
    

Answer 1

一个快速遍历数据的辅助函数：

func <- function(mtx) {
  na <- mtx[1][NA]
  c(NA, sapply(seq_len(nrow(mtx))[-1], function(ind) {
    v <- mtx[ind,1] ; s <- seq_len(ind-1)
    m <- cbind(v == mtx[s,1], v == mtx[s,2])
    if (any(m)) {
      m <- which(m, arr.ind = TRUE)
      row <- which.max(m[,1])
      mtx[m[row,1], m[row,2] %% 2 + 1]
    } else na
  }))
}

演示：

dat[, Prev1 := func(cbind(stim1, stim2)) ][, Prev2 := func(cbind(stim2, stim1)) ]
#    stim1 stim2 Prev1 Prev2
#    <int> <int> <int> <int>
# 1:     2     3    NA    NA
# 2:     1     3    NA     2
# 3:     2     1     3     3
# 4:     1     2     2     1
# 5:     3     1     1     2

---

替代方案，使用zoo::rollapply:

func2 <- function(mtx) {
  na <- mtx[1][NA]
  if (!is.matrix(mtx)) return(na) # we're on the first row
  v <- mtx[nrow(mtx),1] ; s <- seq_len(nrow(mtx)-1)
  m <- cbind(v == mtx[s,1], v == mtx[s,2])
  if (any(m)) {
    m <- which(m, arr.ind = TRUE)
    row <- which.max(m[,1])
    mtx[m[row,1], m[row,2] %% 2 + 1]
  } else na
}
dat[, Prev1 := zoo::rollapplyr(.SD, .N, FUN = func2, by.column = FALSE, partial = TRUE),
    .SDcols = c("stim1", "stim2")
    ][, Prev2 := zoo::rollapplyr(.SD, .N, FUN = func2, by.column = FALSE, partial = TRUE),
      .SDcols = c("stim2", "stim1") ]

它不是更短，实际上是更慢（使用 5 行数据集），但如果您更愿意以滚动方式来考虑它，这会产生相同的结果。 （与此相比，较新的 slider 包可能更清晰、更快，或者两者都没有。）

---

注意：

• 我将na 分配为特定于类的NA（NA 至少有六种类型）。我这样做是防御性的：如果至少有一场比赛，那么 NA 值的其余部分将被强制转换为正确的类；但是，如果没有匹配，那么func 返回的类将是logical，这可能与原始数据不同，data.table 会报错。

Answer 2

以防万一有人对tidyverse 方法感兴趣（可能没那么快！）。您可以将行号添加到您的 data.frame，并将其放入长格式。然后，按每个值分组，获取前一个行号和stim 以在Prev 中引用。使用left_join，您可以获得Prev 的适当值。

library(tidyverse)

df <- mutate(as.data.frame(df), rn = row_number())

df_long <- pivot_longer(df, 
                        cols = -rn, 
                        names_to = "stim", 
                        names_pattern = "stim(\\d+)", 
                        names_transform = list(stim = as.numeric))

df_long %>%
  group_by(value) %>%
  mutate(match_rn = lag(rn), match_stim = 3 - lag(stim)) %>%
  left_join(df_long, by = c("match_rn" = "rn", "match_stim" = "stim")) %>%
  pivot_wider(id_cols = rn, 
              names_from = stim, 
              values_from = value.y, 
              names_prefix = "Prev") %>%
  right_join(df) %>%
  arrange(rn)

输出

     rn Prev1 Prev2 stim1 stim2
  <int> <int> <int> <int> <int>
1     1    NA    NA     2     3
2     2    NA     2     1     3
3     3     3     3     2     1
4     4     2     1     1     2
5     5     1     2     3     1

Answer 3

这是另一种选择：

setDT(DT)[, rn := .I]

dt1 <- DT[DT, on=.(stim1, rn<rn), mult="last", .(x.rn, v=x.stim2)]
dt2 <- DT[DT, on=.(stim2=stim1, rn<rn), mult="last", .(x.rn, v=x.stim1)]
DT[, Prev1 := fcoalesce(fifelse(dt1$x.rn > dt2$x.rn, dt1$v, dt2$v), dt1$v, dt2$v)]

#have not flipped everything and seems to work for this minimal example, pls let me know if there are cases where Prev2 is wrong
dt1 <- DT[DT, on=.(stim2, rn<rn), mult="last", .(x.rn, v=x.stim1)]
dt2 <- DT[DT, on=.(stim1=stim2, rn<rn), mult="last", .(x.rn, v=x.stim2)]
DT[, Prev2 := fcoalesce(fifelse(dt1$x.rn > dt2$x.rn, dt1$v, dt2$v), dt1$v, dt2$v)]

输出：

   stim1 stim2 rn Prev1 Prev2
1:     2     3  1    NA    NA
2:     1     3  2    NA     2
3:     2     1  3     3     3
4:     1     2  4     2     1
5:     3     1  5     1     2

数据：

library(data.table)
DT <- structure(list(stim1 = c(2L, 1L, 2L, 1L, 3L),
               stim2 = c(3L, 3L, 1L, 2L, 1L)),
          row.names = c(NA, -10L), class = c("data.table", "data.frame"))

Answer 4

棘手的是，OP 想要在任一列中找到先前出现的值。

因此，想法是将数据重塑为长格式，并通过在非等自连接中聚合来找到匹配的行。

library(data.table)
long <- melt(DT, measure.vars = patterns("^stim"), value.name = "stim")[
  , rn := rowid(variable)][
    , opposite := rev(stim), keyby = rn][]
long[, prev := long[long, on = c("stim", "rn < rn"), 
                    .(max(x.rn), x.opposite[which.max(x.rn)]), by = .EACHI]$V2][] 
dcast(long, rn ~ rowid(rn), value.var = c("stim", "prev"))

   rn stim_1 stim_2 prev_1 prev_2
1:  1      2      3     NA     NA
2:  2      1      3     NA      2
3:  3      2      1      3      3
4:  4      1      2      2      1
5:  5      3      1      1      2

说明

1. 将DT 重塑为长格式。

2. 使用rowid(variable) 创建一个附加列rn，用于标识原始数据集DT 中的行号。

3. 创建一个附加列opposite，其中包含相反列的值。在长格式中，这意味着在每个rn 组中反转值的顺序。

4. 现在，加入long 本身。非 equi 连接条件是在当前行之前的行中查找所有出现的当前 stim 值。由于可能存在多个匹配项，因此在 .EACHI 组内按 max(rn) 聚合会选择上一次出现值的行号以及相应的 opposite 值。所以，
   long[long, on = c("stim", "rn < rn"), .(max(x.rn), x.opposite[which.max(x.rn)]), by = .EACHI]
   返回

       stim rn V1 V2
    1:    2  1 NA NA
    2:    3  1 NA NA
    3:    1  2 NA NA
    4:    3  2  1  2
    5:    2  3  1  3
    6:    1  3  2  3
    7:    1  4  3  2
    8:    2  4  3  1
    9:    3  5  2  1
   10:    1  5  4  2
   

5. 在long 中创建一个附加列prev，其中包含上一个相反值V2。

6. 最后，使用stim 和prev 这两个度量列将long 重新整形为宽格式。

编辑：替代解决方案

如果DT 包含更多列而仅stim1 和stim2，DT 可以通过引用更新，或者：

long <- melt(DT, measure.vars = patterns("^stim"), value.name = "stim")[
  , rn := rowid(variable)][
    , opposite := rev(stim), keyby = rn][]
DT[, c("prev1", "prev2") := dcast(
  long[long, on = c("stim", "rn < rn"), 
       .(max(x.rn), x.opposite[which.max(x.rn)]), by = .EACHI], 
  rn ~ rowid(rn), value.var = "V2")[, rn := NULL]][]

   stim1 stim2 prev1 prev2
1:     2     3    NA    NA
2:     1     3    NA     2
3:     2     1     3     3
4:     1     2     2     1
5:     3     1     1     2

数据

library(data.table)
DT <- data.table(stim1 = c(2L, 1L, 2L, 1L, 3L),
                 stim2 = c(3L, 3L, 1L, 2L, 1L))