Removing rows in data.frame having columns subsumed in others

Viewed 86

I am trying to achieve something similar to unique in a data.frame where column each element of a column in a row are vectors. What I want to do is if the elements of the vector in the column of that hat row a subset or equal to another remove the row with smaller number of elements. I can achieve this with a nested for loop but since data contains 400,000 rows the program is very inefficient.

Sample data

# Set the seed for reproducibility 
set.seed(42)

# Create a random data frame
mydf <- data.frame(items = rep(letters[1:4], length.out = 20), 
                   grps = sample(1:5, 20, replace = TRUE),
                   supergrp =  sample(LETTERS[1:4], replace = TRUE))


# Aggregate items into a single column
temp <- aggregate(items ~ grps + supergrp, mydf, unique)

# Arrange by number of items for each grp and supergroup 
indx <- order(lengths(temp$items), decreasing = T)
temp <- temp[indx, ,drop=FALSE]

Temp looks like

       grps supergrp   items
    1     4        D a, c, d
    2     3        D    c, d
    3     5        D    a, d
    4     1        A       b
    5     2        A       b
    6     3        A       b
    7     4        A       b
    8     5        A       b
    9     1        D       d
   10     2        D       c

Now you can see that second combination of supergrp and items in second and third row is contained in first row. So, I want to delete the second and third rows from the result. Similarly, rows 5 to 8 are contained in row 4. Finally, rows 9 and 10 are contained in the first row, so I want to delete rows 9 and 10. Hence, my result would look like:

      grps supergrp   items
    1    4        D a, c, d
    4    1        A       b 

My implementation is as follows::

# initialise the result dataframe by first row of old data frame
newdf <-temp[1, ]

# For all rows in the the original data
for(i in 1:nrow(temp))
{
  # Index to check if all the items are found 
  indx <- TRUE

  # Check if item in the original data appears in the new data
  for(j in 1:nrow(newdf))
  {
   if(all(c(temp$supergrp[[i]], temp$items[[i]]) %in% 
          c(newdf$supergrp[[j]], newdf$items[[j]]))){
     # set indx to false if a row with same items and supergroup  
     # as the old data is found in the new data
    indx <- FALSE
   }
  }

  # If none of the rows in new data contain items and supergroup in old data append that
  if(indx){
    newdf <- rbind(newdf, temp[i, ])
  }
}

I believe there is an efficient way to implement this in R; may be using the tidy framework and dplyr chains but I am missing the trick. Apologies for a longish question. Any input would be highly appreciated.

1 Answers
Related