查找先前出现的值并在相对列中获取值
Find previous occurrence of a value and get value in opposite column
我有这样的数据：
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"))
我的 objective 是添加两列：一列用于 '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
循环访问数据的快速辅助函数：
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指定为class-特定的NA（至少有六种类型的NA）。我这样做是为了防御：如果至少有一个匹配项，那么 NA 值的其余部分将被强制转换为正确的 class；但是，如果没有匹配，那么 func 返回的 class 将是 logical ，这可能与原始数据不同，并且 data.table 会报错。
以防万一有人对 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
这是另一个选项：
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"))
棘手的是，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
说明
将 DT 重塑为长格式。
创建一个附加列 rn，使用 rowid(variable) 标识原始数据集 DT 中的行号。
创建一个附加列 opposite，其中包含相对列的值。在长格式中，这意味着在每个 rn 组 .
中反转值 的顺序
现在，加入long自身。非相等连接条件正在查找当前行 之前的行 中所有出现的当前stim 值。由于可能有多个匹配项，在 .EACHI 组内按 max(rn) 聚合会选择前一次出现的值 的行号 以及相应的opposite 值。所以，
long[long, on = c("stim", "rn < rn"), .(max(x.rn), x.opposite[which.max(x.rn)]), by = .EACHI]
returns
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
在 long 中创建一个附加列 prev，其中包含 前一个相反的 值 V2.
最后，使用度量列 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))
我有这样的数据：
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"))
我的 objective 是添加两列：一列用于 '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
循环访问数据的快速辅助函数：
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指定为class-特定的NA（至少有六种类型的NA）。我这样做是为了防御：如果至少有一个匹配项，那么NA值的其余部分将被强制转换为正确的 class；但是，如果没有匹配，那么func返回的 class 将是logical，这可能与原始数据不同，并且data.table会报错。
以防万一有人对 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
这是另一个选项：
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"))
棘手的是，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
说明
将
DT重塑为长格式。创建一个附加列
rn，使用rowid(variable)标识原始数据集DT中的行号。创建一个附加列
中反转值 的顺序opposite，其中包含相对列的值。在长格式中，这意味着在每个rn组 .现在，加入
long自身。非相等连接条件正在查找当前行 之前的行 中所有出现的当前stim值。由于可能有多个匹配项，在.EACHI组内按max(rn)聚合会选择前一次出现的值 的行号 以及相应的opposite值。所以，
long[long, on = c("stim", "rn < rn"), .(max(x.rn), x.opposite[which.max(x.rn)]), by = .EACHI]
returnsstim 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在
long中创建一个附加列prev，其中包含 前一个相反的 值V2.最后，使用度量列
将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))