Create all possible combinations of my dataframe columns in R

Viewed 644

I am working with a data frame in R which has following columns:

Input Data Frame

I would like to create a new data frame with all possible combinations of my columns(data should be multiplied) and have data populated as table below. The tricky part is that if higher combinations of variables have a value of 1, the all lower combinations should be made zero. For instance, in the third row; a=1, b=1, c=1. Here, abc = 1 and all other combinations should be made NA as they are a subset of abc. I have 6 columns in my original data frame, hence making things more complex.

Output Data Frame

4 Answers

I'd suggest using

na.act <- getOption('na.action')
options('na.action' = na.pass)

# Create wide data.
df_wide <- as.data.frame(model.matrix(~ (.)^3 - RESPID,  #replace 3 with the number of columns in your data
                        data = df))
options('na.action' = na.act)
df_wide$RESPID <- df$RESPID

Edit:

Spenting a bit of time, I came up with a solution. It requires a large amount of transforming your data, grouping, nesting and might be more inefficient than the answer provided by @Jonas. But it does the job stepwise. It is... Somewhat readable, and otherwise commented. It's done using 3 basic steps as my main idea. They are described in the code, but the code itself is not documented well.

Initialization:

df <- data.frame(RESPID = 1:3, A = c(1, NA, 1), B = c(NA, 1, 1), C = c(1, 1, 1))

# Start by creating a wide data.frame using model.matrix
na.act <- getOption('na.action')
options('na.action' = na.pass)
df_wide <- as.data.frame(model.matrix(~ (.- RESPID)^3 - 1,  #replace 3 with the number of columns in your data
                                      data = df))
options('na.action' = na.act)
df_wide$RESPID <- df$RESPID
df_wide

Step 1:

# Next lets get the groups that should actually be filled.
# To do this, we'll 
# first) make a "long" format, with all the values that are currently filled.
# second) Find the active columns (A, B, C in this case) for the values that are filled, and count the number of active columns
# third) Find the maximum number of active columns for each active column (A, B, C)
# It is not very readable.
library(tidyverse)
library(stringr)
# Create a long version of the data, and split columns into multiple names.
df_longer <- pivot_longer(df_wide, cols = 1:7) %>% 
  mutate(name_split = str_split(name, ':')) %>% 
  mutate(col_count = lengths(name_split)) %>%
  unnest_wider(name_split) %>%
  # Sort by the number of letters used.
  arrange(col_count) %>% 
  rename('First_active' = '...1',
         'Second_Active' = '...2',
         'Third_Active' = '...3') %>% 
  pivot_longer(cols = 4:6, 
               names_to = 'second_name',
               values_to = 'second_value') 

Step 2 (and 3 somewhat):


# Find the columns with maximum number of letters used:
max_indx <- 
  df_longer %>% group_by(second_name) %>%
    drop_na(second_value, value) %>% 
    ungroup() %>%
    select(RESPID, second_value, value, col_count) %>%
    group_by(second_value, RESPID) %>%
    summarize(indx_max = max(col_count), .groups = 'drop') %>% 
    group_by(RESPID) %>%
    nest(data = second_value) %>% 
    select(data) %>%
    mutate(colname = paste0(data[[1]][[1]], collapse = ':')) %>% 
    ungroup() %>% 
    select(-data)

# Print for visualization
max_indx
# A tibble: 3 x 2
  RESPID colname
   <int> <chr>  
1      1 A:C    
2      3 A:B:C  
3      2 B:C  

Step 3 (or 4?):


# Now that we have the max indices, lets overwrite the values in df_wide
for(i in seq_len(nrow(max_indx))){
  name <- max_indx$colname[max_indx$RESPID == i]
  df_wide[df_wide$RESPID == i, name] <- 1
  df_wide[df_wide$RESPID == i, colnames(df_wide)[!colnames(df_wide) %in% c(name, 'RESPID')]] <- 0
}
df_wide
  A B C A:B A:C B:C A:B:C RESPID
1 0 0 0   0   1   0     0      1
2 0 0 0   0   0   1     0      2
3 0 0 0   0   0   0     1      3

Here is a solution, it is not well optimized but I hope it does the job:

ff <- function(df=data.frame(A=c(1,NA,1),B=c(NA,1,1),C=c(1,1,1))) {
  if(NCOL(df)==1) return(df)
  #create all possible combinations of names
  combinations <- unlist(lapply(2:NCOL(df), function(k) {
    kCombs <- utils::combn(names(df),k)
    apply(kCombs,2,paste0,collapse=",")
  }))
  #go through all combinations and calculate the product of the associated columns
  allColumnProducts <- lapply(combinations, function(combi) {
    colNamesInCombi <- strsplit(combi,",")[[1]]
    dfColList <- as.list(df[,colNamesInCombi])
    poductOfCols <- Reduce(f = "*",
                           x = as.list(df[,colNamesInCombi]),
                           init = numeric(NROW(df))+1)
    setNames(data.frame(poductOfCols),combi)
  })
  #put everything in one dataframe including the initial dataframe
  allColumnProducts <- do.call("cbind",allColumnProducts)
  allColumnProducts <- cbind(df,allColumnProducts)
  #clear all the subsets and make them NA
  for(columnIndex in NCOL(allColumnProducts):(NCOL(df)+1)) {
    rowsWithOne <- allColumnProducts[,columnIndex]==1
    rowsWithOne[is.na(rowsWithOne)] <- FALSE
    if(any(rowsWithOne)) {
      #we found a 1 in the column, so we have to make all columns whose
      #names are part of the name of the current column NA at these rows with 1
      nameParts <- strsplit(names(allColumnProducts)[columnIndex],",")[[1]]
      namesToFillWithNa <- unlist(lapply(1:(length(nameParts)-1), function(k) {
        kCombs <- utils::combn(nameParts,k)
        apply(kCombs,2,paste0,collapse=",")
      }))
      allColumnProducts[rowsWithOne,namesToFillWithNa] <- NA 
    }
  }
  allColumnProducts
}

You can just call it with a dataframe. If the names in your dataframe also include ",", then for pasting and splitting you will need another unique character. I hope the comments describe well what it does as well as the chosen names of the variables.

Update:

I just thought some more about this task and I made some optimizations in the part of creating the big data frame before cleaning columns up with NAs. Moreover I added the arguments uniqueString and removeUniqueStringInResult. uniqueString is a string which should not occur in the names of the dataframe. Otherwise some strsplits will fail. removeUniqueStringInResult clears the uniqueString in the names of the resulting dataframe. I thought it is nice, since now you get exactly your desired results. If the names of the columns are single characters, there is no confusion if one just pasts the names together without seperating character.

ff2 <- function(df, 
                uniqueString = ",",
                removeUniqueStringInResult = TRUE) {
  if(NCOL(df)==1) return(df)
  #go through all combinations of size k, k=2,...,NCOL(df), and calculate the product of the associated columns
  allColumnProducts <- lapply(2:NCOL(df), function(k) {
    kCombs <- utils::combn(names(df),k)
    #the columns are all possible combinations of size k of the names
    kComdDataframe <- lapply(1:NCOL(kCombs), function(i) {
      colNamesInCombi <- kCombs[,i] #columns in the origianl dataframe df with these names have to be multiplied together
      Reduce(f = "*",
             x = as.list(df[,colNamesInCombi]),
             init = numeric(NROW(df))+1)
    })
    kComdDataframe <- data.frame(do.call("cbind",kComdDataframe))
    kCombNames <- apply(kCombs,2,paste0,collapse=uniqueString)
    names(kComdDataframe) <- kCombNames
    kComdDataframe
  })
  #put everything in one dataframe including the initial dataframe
  allColumnProducts <- do.call("cbind",allColumnProducts)
  allColumnProducts <- cbind(df,allColumnProducts)
  #clear all the subsets and make them NA
  for(columnIndex in NCOL(allColumnProducts):(NCOL(df)+1)) {
    rowsWithOne <- allColumnProducts[,columnIndex]==1
    rowsWithOne[is.na(rowsWithOne)] <- FALSE
    if(any(rowsWithOne)) {
      #we found a 1 in the column, so we have to make all columns whose
      #names are part of the name of the current column NA at these rows with 1
      nameParts <- strsplit(names(allColumnProducts)[columnIndex],",")[[1]]
      namesToFillWithNa <- unlist(lapply(1:(length(nameParts)-1), function(k) {
        kCombs <- utils::combn(nameParts,k)
        apply(kCombs,2,paste0,collapse=uniqueString)
      }))
      allColumnProducts[rowsWithOne,namesToFillWithNa] <- NA 
    }
  }
  if(removeUniqueStringInResult) {
    names(allColumnProducts) <- gsub(uniqueString,"",names(allColumnProducts))
  } 
  allColumnProducts
}

The execution time improved quite well, see following benchmark:

testdf <- data.frame(A=c(1,NA,1),B=c(NA,1,1),C=c(1,1,1),D=c(1,1,1),E=c(1,NA,1))
microbenchmark::microbenchmark(ff(testdf),ff2(testdf))
#Unit: milliseconds
#      expr    min      lq      mean  median       uq     max neval
#ff(testdf) 8.6415 8.87095 10.238998 9.00815 11.38315 23.0477   100
#ff2(testdf) 3.7638 3.86935  4.905192 4.00970  5.36295 14.2669   100

Here is a rather concise tidyverseapproach. See my in-line comments. Note that this approach will not create columns that are NA only. But it is easy to add those, if needed.

library(tidyverse)

df <- data.frame(RESPID = 1:3, A = c(1, NA, 1), B = c(NA, 1, 1), C = c(1, 1, 1))

res_df <- df %>%
  # create new columns A:C where `1` is replaced with column name
  mutate(across(c(A:C), 
                list(`2` = ~ ifelse(!is.na(.x),
                         cur_column(),
                         NA_character_))
                ),
  # check if old columns should be set to NA
         across(c(A:C),
                ~ case_when(
                  .x == 1 & rowSums(across(c(A:C))) == 1 ~ .x,
                  TRUE ~ NA_real_)
                )
         ) %>% 
  rowwise() %>% 
  # create new column which contains new column name to be created
  mutate(res = paste(na.omit(c_across(A_2:C_2)), collapse = ""),
  # we want to pass this value to our new columns
         val = 1) %>% 
  # now lets create the columns with pivot_wider
  pivot_wider(id_cols = c(RESPID:C),
              names_from = res,
              values_from = val)

res_df
#> # A tibble: 3 x 7
#>   RESPID     A     B     C    AC    BC   ABC
#>    <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1      1    NA    NA    NA     1    NA    NA
#> 2      2    NA    NA    NA    NA     1    NA
#> 3      3    NA    NA    NA    NA    NA     1

Created on 2020-11-04 by the reprex package (v0.3.0)

first of all, Thank you so much for your answers. I really appreciate your time. I did go with a more greedy approach as it involved less coding. Here's what I did.

#Shout out to @oliver for the first part of the code

df <- data.frame(RESPID = 1:3, A = c(1, NA, 1), B = c(NA, 1, 1), C = c(1, 1, 1))

# Start by creating a wide data.frame using model.matrix
na.act <- getOption('na.action')
options('na.action' = na.pass)
df_wide <- as.data.frame(model.matrix(~ (.- RESPID)^3 - 1,  #replace 3 with the number of columns in your data
                                      data = df))
options('na.action' = na.act)
df_wide$RESPID <- df$RESPID
df_wide

#Below is the logic I used
#So, for each respondent, we calculate how many of the inital A,B,C were selected.

df_wide$count_selected<- rowSums(df_wide[, c("A","B","C")], na.rm = TRUE)

 df_wide
   A  B C A:B A:C B:C A:B:C RESPID count_selected
1  1 NA 1  NA   1  NA    NA      1              2
2 NA  1 1  NA  NA   1    NA      2              2
3  1  1 1   1   1   1     1      3              3


#Now, we can make use of count_selected to get rid of other columns. 
For instance; for count_selected = 3, we can get rid of all one and two column combinations.
#This could be coded in a better way, but I did it manually.

initial_columns = c("A","B","C")
two_combinations = c("A:B","A:C","B:C")
three_combinations = "ABC"

df_wide[df_wide$count_selected == 3,c(initial_columns, two_combinations)]<- NA
df_wide[df_wide$count_selected == 2,initial_columns]<- NA


df_wide
   A  B  C A:B A:C B:C A:B:C RESPID count_selected
1 NA NA NA  NA   1  NA    NA      1              2
2 NA NA NA  NA  NA   1    NA      2              2
3 NA NA NA  NA  NA  NA     1      3              3


Related