r语言 - 改变一个新列，该列是与 .row 差异最小的行的row_id列表

Question

tibble(
A= c("x","x","y","y"),
B= c("y","y","y","y"),
C= c("x","y","z","y")
)  %>%
mutate(
id = row_number(),
.before = "A"
) %>%
mutate(
neighs_id = list(
c("2"),
c("1,4"),
c("4"),
c("2,3")
)
) %>% View()

neighs_id的输出是id_row列表，当TRUE==1A、B或C的值恰好从同一列中的该.row中的值!=的条件。

我想要一个代码将第二个突变替换为map，该的结果是所有行的list(保留：操作将rowise！)，给定一组列，具有1列的值!=列[.row]。

理论上，我可以设置一个idXid的方阵，检查 tibble 的列sum，以便column[id] =! column[column[.id]，然后保留元素== 1的所有匹配项，但我认为这应该是一种更直接的方法在这些"最小不同的行"上选择矢量化filter， 给定列的选择器。

Answer 1

在基本 R 中：

cols = LETTERS[1:3]
tib$neighs_id <- lapply(seq(nrow(tib)), 
function(i) which(sapply(seq(nrow(tib)),
function(x) sum(tib[x, cols] != tib[i, cols])) == 1))

#> pull(tib, neighs_id)
[[1]]
[1] 2
[[2]]
[1] 1 4
[[3]]
[1] 4
[[4]]
[1] 2 3

Answer 2

加快速度的一种方法是不使用tibbles，而是使用矩阵。我想这是因为 tibbles(或数据框)是列的列表，因此与使用矩阵相比，重复提取行的成本很高。

通过将字符矩阵更改为数字矩阵，可以实现另一个显着的改进，以便可以对某些操作进行矢量化。这样，Maël答案的内部sapply可以替换为减法和矩阵列求和。

n.rep <- 1
tib <- tibble(
A=rep(c("x", "x", "y", "y"), n.rep),
B=rep(c("y", "y", "y", "y"), n.rep),
C=rep(c("x", "y", "z", "y"), n.rep)
)
cols <- LETTERS[1:3]
# change tibble to a matrix
tib.m <- as.matrix(tib[, cols])
# named vector used to translate values to their order
val.ord <- unique(c(tib.m))
val.ord <- setNames(seq_along(val.ord), val.ord)
# create numeric representation using the orders
tib.m[] <- val.ord[tib.m]
mode(tib.m) <- 'numeric'
tib$neighs_id <- apply(tib.m, 1, function(row) 
which(colSums(t(tib.m) - row != 0) == 1))

当n.rep为 1000 时，这将在大约一秒内完成(即，tib是一个 4000 行的矩阵)。然而，恐怕将其扩展到1M可能仍然存在问题。为此，使用Rcpp可能会有所帮助。