在data.table中，比较行并根据此比较将组号放入每行，R中没有循环

Question

I have a data.table with several columns and within these columns, a column is designed to received the group number of each row (group_id). At the beginning, the column group_id is filled with the number of the row. The value on the column may be at 'NA' except for the group_id column. I have a huge data set so I can't do that using loop because it's too slow.

Here a small example of what is my data.table at first :

library(data.table)
group_id = c(1,2,3,4)
type1 = c(1,5,7,5)
type2 = c(3,3,4,NA)
type3 = c(6,7,NA,NA)
df <- data.table(group_id, type1, type2, type3)
df

   group_id type1 type2 type3
1:        1     1     3     6
2:        2     5     3     7
3:        3     7     4    NA
4:        4     5    NA    NA

What I want to achieve is to change the group_id based on the comparison (if it's equal) of each row with the other by column. The lower group_id value with always be the one kept. For the previous example, the result expected would be :

   group_id type1 type2 type3
1:        1     1     3     6
2:        1     5     3     7
3:        3     7     4    NA
4:        1     5    NA    NA

• group_id for the row 2 is changed to 1 because the row 2 shares the same type2 value (type2==3)
• group_id for the row 3 is unchanged
• group_id for the row 4 is changed to 1 because the row 4 shares the same type1 value (type1==5)

This is my second question here so if I made mistakes don't hesitate to tell me where, thank you.

Answer 1

Here is a possible approach using igraph .

For each ^type* column, remove NAs first. Then for each unique type value within this ^type* column, create a network where each vertex is joined to every other vertex (ie a full citation graph).

Then, union all these sub-networks to create clusters where group_id s within the same cluster share one or more identical type values.

Next, find the earliest group_id within each cluster.

Finally, lookup the cluster that each group_id is in.

library(igraph)
cols <- paste0("type", 1:3)
lg <- list()

#for each type column
for (x in cols) {
    lg <- c(lg, DT[!is.na(get(x)), #remove NAs
        {
            #create graph and label vertices
            gix <- unique(group_id)
            cg <- make_full_citation_graph(length(gix), FALSE)
            V(cg)$name <- as.character(gix)
            .(.(cg))
        }, 
        by=x]$V1)
}

#union all subgraphs
ug <- do.call(union, c(lg, list(byname=TRUE)))
#plot(ug)

#find the earliest group_id for each cluster
clu <- clusters(ug)$membership
split(clu, clu) <- lapply(split(clu, clu), function(x) min(names(x)))

#lookup to update the original dataset
DT[, new_gid := clu[as.character(group_id)]]
DT

output:

   group_id type1 type2 type3 new_gid
1:        1     1     3     6       1
2:        2     5     3     7       1
3:        3     7     4    NA       3
4:        4     5    NA    NA       1

data:

library(data.table)
group_id = c(1,2,3,4)
type1 = c(1,5,7,5)
type2 = c(3,3,4,NA)
type3 = c(6,7,NA,NA)
DT <- data.table(group_id, type1, type2, type3)

---

edit: probably overkill on using igraph . This Rcpp version should be faster

library(Rcpp)
cppFunction("
IntegerVector gclu(IntegerVector id, IntegerVector typ1, IntegerVector typ2, IntegerVector typ3) {
    int i, j, sz = id.size();

    for (i=0; i<sz; i++) {
        for (j=0; j<=i; j++) {
            if ((!IntegerVector::is_na(typ1[i]) && !IntegerVector::is_na(typ1[j]) && typ1[i]==typ1[j]) ||
                (!IntegerVector::is_na(typ2[i]) && !IntegerVector::is_na(typ2[j]) && typ2[i]==typ2[j]) ||
                (!IntegerVector::is_na(typ3[i]) && !IntegerVector::is_na(typ3[j]) && typ3[i]==typ3[j])) {

                id[i] = id[j];
                break;
            }
        }
    }

    return(id);
}
")
DT[, gclu(group_id, type1, type2, type3)]

Answer 2

Here is the way I achieve to group the row, it's might be clumsy, I'm new in R coding :

group <- function(table) {
  # Index in table
  group.id <- 1

  # Length of table ie number of row
  length.table <- length(table[[1]])

  # Loop on the table O(n) = n(n-1)/2 with n the number of row
  for (i in 1:(length.table - 1)) {
    for (j in (i + 1):length.table) {
      # Go to the next comparison if the two row are already grouped
      if (table[[group.id]][i] == table[[group.id]][j]) {
        next
      } else {
        for (k in (group.id + 1):length.table) {
          # If the two value are equal (and not NA)
          if (!is.na(table[[k]][i]) &
              !is.na(table[[k]][j]) &
              table[[k]][i] == table[[k]][j]) {
            # Then group them with the lesser value of group.id
            if (table[[group.id]][i] < table[[group.id]][j]) {
              table[[group.id]][j] <- table[[group.id]][i]
            } else {
              table[[group.id]][i] <- table[[group.id]][j]
            }
          }
        }
      }
    }
    # If all the row are grouped then return the result
    if (uniqueN(table[[group.id]]) == 1) {
      return(table[[group.id]])
    } 
  }
  return(table[[group.id]])
}

dt[, group.id := group(c(list(group.id, type1, type2, type3)))]

print(dt)

Output :

   group.id type1 type2 type3
1:        1     1     3     6
2:        1     5     3     7
3:        3     7     4    NA
4:        1     5    NA    NA

Data :

library(data.table)
group.id <- c(1, 2, 3, 4)
type1 <- c(1, 5, 7, 5)
type2 <- c(3, 3, 4, NA)
type3 <- c(6, 7, NA, NA)
dt <- data.table(group.id, type1, type2, type3)