Mutate a new column that is the list of the row_id of minimally different rows from .row

user_17122831 0
Viewed 56
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()

The output of neighs_id is the list of id_row when is TRUE the condition that exactly ==1 value of A,B, or C is != from the values in that .row, in the same columns.

I want a code to replace the second mutate with map that has as outcome a list (keep: the operation would be rowise!) of all the rows that, given a selection of columns, have 1 column with a value != column[.row].

In theory, I could setup a square matrix of id X id, check the sum of columns of the tibble such that column[id] =! column[column[.id] and then keep all the matches where the element == 1, but I think that should be a more straightforward way to select vectorise a filter on these "minimally different rows", given a selector of columns.

purrr dplyr r
2 Answers

In base 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
user_134606020

One way to speed this up is not to work with tibbles but with a matrix instead. I guess this is because tibbles (or data frames) are lists of columns so repeated extraction of rows is expensive compared to working with a matrix.

Another significant improvement can be achieved by changing the character matrix to a numeric one so that some operations can be vectorized. This way the inner sapply from Maël's answer can be replaced with subtraction and summing over matrix columns.

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))

This finishes in about a second when n.rep is 1000 (i.e., tib is a 4000-row matrix). Scaling it up to 1M, however, might still be problematic, I'm afraid. For this, using Rcpp might help.

user_20948930
Related