[R] help with apply, please

[Duncan Murdoch]

On 11/19/2005 8:00 AM, Adrian DUSA wrote:
> Dear list,
> 
> I have a problem with a toy example:
> mtrx <- matrix(c(1,1,0,1,1,1,0,1,1,0,0,1), nrow=3)
> rownames(ma) <- letters[1:3]
> 
> I would like to determine which is the minimum combination of rows that 
> "covers" all columns with at least a 1.
> None of the rows covers all columns; all three rows clearly covers all 
> columns, but there are simpler combinations (1st and the 3rd, or 2nd and 3rd) 
> which also covers all columns.
> 
> I solved this problem by creating a second logical matrix which contains all 
> possible combinations of rows:
> tt <- matrix(as.logical(c(1,0,0,0,1,0,0,0,1,1,1,0,1,0,1,0,1,1,1,1,1)), nrow=3)
> 
> and then subset the first matrix and check if all columns are covered.
> This solution, though, is highly inneficient and I am certain that a 
> combination of apply or something will do.

First of all, I imagine there isn't a unique solution, i.e. there are 
probably several subsets that can't be reduced but which are not equal. 
  Do you care if you find the smallest one of those?  If so, it looks 
like a reasonably hard problem.  If not, it's a lot easier:  total all 
of the columns, then see if there is any row whose entries all 
correspond to columns with counts bigger than 1.  Remove it, and continue.

This will find a local minimum in one pass through the rows.

You could make it better by sorting the rows into an order so that rows 
that dominate other rows come later, but I think you still wouldn't be 
guaranteed to find the global min.  (By the way, I'm not sure if we have 
a function that can do this:  i.e., given a partial ordering on the 
rows, sort the matrix so that the resulting order is consistent with it.)

Duncan Murdoch

> 
> ###########################
> 
> possibles <- NULL
> length.possibles <- NULL
> ## I guess the minimum solution is has half the number of rows
> guesstimate <- floor(nrow(tt)/2) + nrow(tt) %% 2
> checked <- logical(nrow(tt))
> repeat {
>     ifelse(checked[guesstimate], break, checked[guesstimate] <- TRUE)
>     partials <- as.matrix(tt[, colSums(tt) == guesstimate])
>     layer.solution <- logical(ncol(partials))
>     
>     for (j in 1:ncol(partials)) {
>         if (length(which(colSums(mtrx[partials[, j], ]) > 0)) == ncol(mtrx)) {
>             layer.solution[j] <- TRUE
>         }
>     }
>     if (sum(layer.solution) == 0) {
>         if (!is.null(possibles)) break
>         guesstimate <- guesstimate + 1
>     } else {
>         for (j in which(layer.solution)) {
>             possible.solution <- rownames(mtrx)[partials[, j]]
>             possibles[[length(possibles) + 1]] <- possible.solution
>             length.possibles <- c(length.possibles, length(possible.solution))
>         }
>         guesstimate <- guesstimate - 1
>     }
> }
> final.solution <- possibles[which(length.possibles == min(length.possibles))]
> 
> ###########################
> 
> More explicitely (if useful) it is about reducing a prime implicants chart in 
> a Quine-McCluskey boolean minimisation algorithm. I tried following the 
> original algorithm applying row dominance and column dominance, but (as I am 
> not a computer scientist), I am unable to apply it.
> 
> If you have a better solution for this, I would be gratefull if you'd share 
> it.
> Thank you in advance,
> Adrian
>