Find previous occurrence of a value and get value in opposite column - r

Question

I have data like this:
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"))
My objective is to add two columns: one for 'stim1' and one for 'stim2'. For each row of both columns, I want to find the previous occurrence of its value, in either column, and then grab the value in the opposite column.
For example, on row 3 'stim1' is 2. The previous occurrence of 2 is in 'stim1' on row 1. The value in the other column of that row is 3. So Prev1[3] is 3.
Another example: On row 4 'stim1' is 1. The previous occurrence of 1 is in 'stim2' on row 3. The value in the other column on that row is 2. So Prev1[4] is 2.
Desired output:
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

The tricky thing is that the OP wants to find the previous occurrence of a value in either column.
Therefore, the idea is to reshape the data into long format and to find the matching rows by aggregating in a non-equi self join.
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
Explanation
Reshape DT to long format.
Create an additional column rn which identifies the row numbers in the original dataset DT using rowid(variable).
Create an additional column opposite which contains the values of the opposite column. In long format this means to reverse the order of values within each rn group.
Now, join long with itself. The non-equi join condition is looking for all occurrences of the current stim value in rows before the current row. As there might be more than one match, aggregating by max(rn) within the .EACHI groups picks the row number of the previous occurrence of the value as well as the corresponding opposite value. So,
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
Create an additional column prev in long which contains the previous opposite value V2.
Finally, reshape long back to wide format, using both measure columns stim and prev.
Edit: Alternative solution
In case DT contains more columns that just stim1 and stim2, DT can be updated by reference, alternatively:
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
Data
library(data.table)
DT <- data.table(stim1 = c(2L, 1L, 2L, 1L, 3L),
stim2 = c(3L, 3L, 1L, 2L, 1L))

Answer 2

A quick helper function to iterate through the data:
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
}))
}
Demonstration:
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
Alternative, using 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") ]
It's not shorter, and in fact is slower (with a 5-row dataset), but if you prefer to think of this in a rolling fashion, this produces the same results. (It's possible the newer slider package might be clearer, faster, or neither compared with this.)
Note:
I assign na as a class-specific NA (there are at least six types of NA). I do this defensively: if there is at least one match, then the remainder of the NA values will be coerced into the correct class; however, if there are no matches, then the class returned by func will be logical which may not be the same as the original data, and data.table will complain.

Answer 3

Just in case there was interest in a tidyverse approach (probably not as fast!). You could add row numbers to your data.frame, and put it into long form. Then, grouping by each value, get the previous row number and stim to reference in Prev. With a left_join you can obtain the appropriate value for 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)
Output
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 4

Here is another option:
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)]
output:
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
data:
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"))