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