Find the rows which make each column have one True (was: Knuth's Algorithm X)

Question

Task

Given a Boolean matrix, find one (or optionally more) subset(s) of rows which have exactly one True in each column. You may use any algorithm, but must support very large matrices, like the last example.

One possible algorithm (Knuth's Algorithm X)

While there is no requirement to use this algorithm, it may be your best option.

1. If the matrix A has no columns, the current partial solution is a valid solution; terminate successfully.
2. Otherwise choose a column c.
3. Choose* a row r such that A_{r, c} = 1.
4. Include row r in the partial solution.
5. For each column j such that A_{r, j} = 1,
    for each row i such that A_{i, j} = 1,
     delete row i from matrix A.
    delete column j from matrix A.
6. Repeat this algorithm recursively on the reduced matrix A.

* Step 3 is non-deterministic, and needs to be backtracked to in the case of a failure to find a row in a later invocation of step 3.

Input

Any desired representation of the minimum 2×2 matrix A, e.g. as a numeric or Boolean array

1 0 0 1 0 0 1
1 0 0 1 0 0 0
0 0 0 1 1 0 1
0 0 1 0 1 1 0
0 1 1 0 0 1 1
0 1 0 0 0 0 1

or as Universe + Set collection

U = {1, 2, 3, 4, 5, 6, 7}
S = {
    A = [1, 4, 7],
    B = [1, 4],
    C = [4, 5, 7],
    D = [3, 5, 6],
    E = [2, 3, 6, 7],
    F = [2, 7]
    }

or as 0 or 1 indexed sets; {{1, 4, 7}, {1, 4}, {4, 5, 7}, {3, 5, 6}, {2, 3, 6, 7}, {2, 7}}.

Output

Any desired representation of one (or optionally more/all) of the solutions, e.g. as numeric or Boolean array of the selected rows

1 0 0 1 0 0 0
0 0 1 0 1 1 0
0 1 0 0 0 0 1

or as Boolean list indicating selected rows {0, 1, 0, 1, 0, 1} or as numeric (0 or 1 indexed) list of selected rows {2, 4, 6} or as list of set names ['B', 'D', 'F'].

More examples

In:

1 0 1
0 1 1
0 1 0
1 1 1

Out: 1 3 or 4 or 1 0 1 0 or 0 0 0 1 or [[1,3],[4] etc.

---

In:

1 0 1 0 1
0 1 0 1 0
1 1 0 0 1
0 1 0 1 1

Out: 1 1 0 0 etc.

---

In:

0 1 0 1 1 0 1
1 1 0 0 1 1 1
0 1 0 0 1 0 0
1 1 1 0 0 0 1
0 0 0 1 1 1 0

Out: 0 0 0 1 1 etc.

---

In:

0 1 1
1 1 0

Out: Nothing or error or faulty solution, i.e. you do not have to handle inputs with no solution.

---

In: http://pastebin.com/raw/3GAup0fr

Out: 0 10 18 28 32 38 48 61 62 63 68 86 90 97 103 114 120 136 148 157 162 174 177 185 186 194 209 210 218 221 228 243 252 255 263 270 271 272 273 280 291 294 295 309 310 320 323 327 339 345 350 353 355 367 372 373 375 377 382 385 386 389 397 411 417 418 431 433 441 451 457 458 459 466 473 479 488 491 498 514 517

---

In: https://gist.github.com/angs/e24ac11a7d7c63d267a2279d416bc694

Out: 553 2162 2710 5460 7027 9534 10901 12281 12855 13590 14489 16883 19026 19592 19834 22578 25565 27230 28356 29148 29708 30818 31044 34016 34604 36806 36918 39178 43329 43562 45246 46307 47128 47906 48792 50615 51709 53911 55523 57423 59915 61293 62087 62956 64322 65094 65419 68076 70212 70845 71384 74615 76508 78688 79469 80067 81954 82255 84412 85227

Answer 1

Haskell, 100 93 92 87 83 80 bytes

Knuth's algorithm:

g&c=filter(g.any(`elem`c))
(u:v)%a=[c:s|c<-id&u$a,s<-(not&c)v%(not&c$a)]
x%_=[x]

Calculates all covers nondeterministically depth-first in the list monad. Use head to calculate only one since Haskell is lazy. Usage:

*Main> [[1],[2],[3],[4],[5],[6],[7]]%[[1, 4, 7], [1, 4], [4, 5, 7], [3, 5, 6], [2, 3, 6, 7], [2, 7]]
[[[1,4],[2,7],[3,5,6]]]

For more speed by using Knuth's suggestion of selecting column with least ones, use this: (115 bytes, flat list for universe). Finds first solution to the large pentomino cover problem in under a minute when compiled.

import Data.List
[]%_=[[]]
w%a=[c:s|c<-a,c\\(head.sortOn length.group.sort$w:a>>=id)/=c,s<-(w\\c)%[b|b<-a,c\\b==c]]

Thanks to @Zgarb for saving 1+3 bytes!

Thanks to @ChristianSievers for his sage advice and saving 5 bytes and some.

Ungolfed (with flat list universe):

knuthX [] _ = [[]]
knuthX (u:niverse) availableRows = --u chosen deterministically
  [ chosen:solution
  | let rows = filter (elem u) availableRows
  , chosen <- rows  --row chosen nondeterministically in list monad
  , solution <- knuthX
                  (filter (not.(`elem`chosen)) niverse)
                  (filter (not.any(`elem`chosen)) availableRows)
  ]

Answer 2

Python, 482 bytes

r=lambda X,Y:u({j:set(filter(lambda i:j in Y[i],Y))for j in X},Y)
def u(X,Y,S=[]):
 if X:
  for r in list(X[min(X,key=lambda c:len(X[c]))]):
   S.append(r);C=v(X,Y,r)
   for s in u(X,Y,S):yield s
   w(X,Y,r,C);S.pop()
 else:yield list(S)
def v(X,Y,r):
 C=[]
 for j in Y[r]:
  for i in X[j]:
   for k in Y[i]:
    if k!=j:X[k].remove(i)
  C.append(X.pop(j))
 return C
def w(X,Y,r,C):
 for j in reversed(Y[r]):
  X[j]=C.pop()
  for i in X[j]:
   for k in Y[i]:
    if k!=j:X[k].add(i)

r is the function to call with the Universe + Set collection.

Golfed a little from this page

Usage:

X = {1, 2, 3, 4, 5, 6, 7}
Y = {
    'A': [1, 4, 7],
    'B': [1, 4],
    'C': [4, 5, 7],
    'D': [3, 5, 6],
    'E': [2, 3, 6, 7],
    'F': [2, 7]}

for a in r(X,Y): print a

Answer 3

R, 124 117 115 113 bytes

Very inefficient, but not that long in code. Tries all possible subsets of rows and checks if all the rows sum to 1.

f=function(x,n=nrow(x))for(i in 1:n)for(j in 1:ncol(z<-combn(n,i)))if(all(colSums(x[k<-z[,j],,drop=F])==1))cat(k)

Takes a matrix as input. Returns the rownumbers of the first solution encountered. Returns nothing if there are no solutions, but might take a long while terminating if the input is big.

Ungolfed:

f=function(x, n=nrow(x)){


    for(i in 1:n){
        z=combn(n,i)

        for(j in 1:ncol(z)){
            k=x[z[,j],,drop=F]

            if(all(colSums(k)==1)){
                print(z[,j])
            }
        }
    }
}

7 bytes saved thanks to Billywob

Another 2 bytes saved thanks to Billywob

Answer 4

APL (Dyalog), 81 bytes

{×≢⍉⍵:⍵∇{~1∊⍵:0⋄0≡s←⍺⍺c/⍺⌿⍨r←~∨/⍺/⍨~c←~,⍺⌿⍨f←<\⍵:⍺∇f<⍵⋄f∨r\s},⍵/⍨<\n=⌊/n←+⌿⍵⋄∧/⍵}

Try it online!

{ anonymous function:

 : if…

  ⍵ If the argument

  ⍉ when transposed

  ≢ has a row-count

  × which is positive

 then

  ⍵∇{… then apply this function with the right argument as left argument (constraint matrix), but only after it has been modified by the following anonymous operator (higher-order function):
   : if…
    1∊⍵ there are ones in the right argument
    ~ NOT
   then…
    0 return zero (i.e. fail)
   ⋄ else:
   : if…
    <\⍵ the first true of the right argument (lit. cumulative less-than; first row)
    f← assign that to f
    ⍺⌿⍨ use that to filter the rows of the left argument
    , ravel (flatten)
    ~ negate
    c← assign that to c
    ~ negate
    ⍺/⍨ use that to filter the columns of the left argument
    ∨/ which rows have a true? (OR reduction)
    ~ negate that
    ⍺⌿⍨ use that to filter the rows of the left argument
    c/ use c to filter the columns of that
    ⍺⍺ apply the original outer function (the left operand; sub-matrix covers)
    s← assign that to s
    0≡ …is identical to zero (failure), then (try a different row):
    f<⍵ right-argument AND NOT f
    ⍺∇ recurse on that (preserving the original left argument)
   ⋄ else:
    r\s use zeros in r to insert zero-filled columns in s
    f∨ return f OR that (success; row f included)
  }… … on

  +⌿⍵ the sum of the argument

  n← assign that to n

  ⌊/ the minimum of that

  n= Boolean where n is equal to that

  <\ the first one of those (lit. cumulative less-than)

  ⍵/⍨ use that to filter the columns of the argument (gives first column with fewest ones)

  , ravel that (flatten)

 ⋄ else

  ∧/⍵ rows which are all ones (none, so this gives a zero for each row)

} end of anonymous function