Select subset of columns which minimise a criterion in R - r

Question

I have a sparse binary data.frame which looks like this
set.seed(123)
dat <- as.data.frame(matrix(rep(round(runif(40,0,0.9),0),5),ncol = 20))
# > dat
# V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16 V17 V18 V19 V20
# 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1
# 2 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1
# 3 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
# 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# 5 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0
# 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# 7 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
# 8 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1
# 9 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0
# 10 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0
I need to find the 3 columns which minimise the number of zeros obtained when I call rowSums on those columns.
Example:
# > rowSums(dat[,1:3])
# [1] 2 2 2 3 2 2 0 2 0 1
#
# > rowSums(dat[,2:4])
# [1] 3 2 3 3 1 2 1 1 0 1
Here when I call rowSums on the first 3 columns I get 2 zeros, while when I call rowSums on columns 2:4 I get only one 0, so the second solution would be preferred.
Of course, I don't need the columns to be next to each other when I apply rowSums, so I need to explore all the possible combinations (ex: I want rowSums to consider also the case ov V1+V5+V17, ...), and if there are multiple "optimal" solutions, It's OK for me to just keep one of them.
Note that my real data.frame is 220.000 rows x 200 columns, so I need an efficient approach in terms of time/memory consumed.

Answer 1

This is the most obvious solution, although likely won't scale very well:
which.min(combn(dat,3L,function(x) sum(rowSums(x)==0)));
## [1] 2
The output value of 2 can be thought of as a combination index. You can get the columns that belong to that combination by running combn() on the complete column index set of the input object and indexing out that particular combination of indexes:
cis <- combn(seq_along(dat),3L)[,2L];
cis;
## [1] 1 2 4
And then getting the column names is easy:
names(dat)[cis];
## [1] "V1" "V2" "V4"
You can get the number of zeroes in the solution as follows:
sum(rowSums(dat[,cis])==0);
## [1] 1
I've written a much faster solution in Rcpp.
To make the function more generic, I wrote it to take a logical matrix rather than a data.frame, with the design of finding the column combination with the fewest all-true rows. Thus, for your case, you can compute the argument as dat==0. I also parameterized the number of columns in the combination as a second parameter r, which will be 3 for your case.
library(Rcpp);
Sys.setenv('PKG_CXXFLAGS'='-std=c++11');
cppFunction('
IntegerVector findColumnComboWithMinimumAllTrue(LogicalMatrix M,int r) {
std::vector<int> rzFull(M.nrow()); std::iota(rzFull.begin(),rzFull.end(),0);
std::vector<int> rzErase;
std::vector<std::vector<int>> rzs(M.ncol(),std::vector<int>(M.nrow()));
std::vector<std::vector<int>*> rzps(M.ncol());
std::vector<int>* rzp = &rzFull;
std::vector<int> com(r);
int bestAllTrueCount = M.nrow()+1;
std::vector<int> bestCom(r);
int pmax0 = M.ncol()-r;
int p = 0;
while (true) {
rzErase.clear();
for (int rzi = 0; rzi < rzp->size(); ++rzi)
if (!M((*rzp)[rzi],com[p])) rzErase.push_back(rzi);
if (p+1==r) {
if (rzp->size()-rzErase.size() < bestAllTrueCount) {
bestAllTrueCount = rzp->size()-rzErase.size();
bestCom = com;
}
if (com[p]==pmax0+p) {
do {
--p;
} while (p >= 0 && com[p]==pmax0+p);
if (p==-1) break;
++com[p];
rzp = p==0 ? &rzFull : rzps[p-1];
} else {
++com[p];
}
} else {
if (rzErase.empty()) {
rzps[p] = rzp;
} else {
rzs[p].clear();
int rzi = -1;
for (int ei = 0; ei < rzErase.size(); ++ei)
for (++rzi; rzi < rzErase[ei]; ++rzi)
rzs[p].push_back((*rzp)[rzi]);
for (++rzi; rzi < rzp->size(); ++rzi)
rzs[p].push_back((*rzp)[rzi]);
rzp = rzps[p] = &rzs[p];
}
++p;
com[p] = com[p-1]+1;
}
}
IntegerVector res(bestCom.size());
for (int i = 0; i < res.size(); ++i)
res[i] = bestCom[i]+1;
return res;
}
');
Here's a demo on your example input:
set.seed(123L);
dat <- as.data.frame(matrix(rep(round(runif(40,0,0.9),0),5),ncol=20L));
findColumnComboWithMinimumAllTrue(dat==0,3L);
## [1] 1 2 4
And here's a full-size test, which takes almost 10 minutes on my system:
set.seed(1L); NR <- 220e3L; NC <- 200L;
dat <- as.data.frame(matrix(sample(0:1,NR*NC,T),NR,NC));
system.time({ findColumnComboWithMinimumAllTrue(dat==0,3L); });
## user system elapsed
## 555.641 0.328 556.401
res;
## [1] 28 64 89