Return to Revisions

Here the problem was solved with a different perspective. You may find other solutions but what made this interesting to me was transforming one problem into another.

Here are the steps:

1. Create random points in 3d space
2. For each point, find points it covers
3. Build a graph out of these connections
4. Find a minimum set of points which can cover all the vertices by their neighborhood (aka cover all the pairs)

Assume we have a set of pairs:

SeedRandom[75];

pairs = RandomInteger[{0, 3}, {20, 3}];

n = Length[pairs];

pairs that have at least two similar axes will be associated for each pair, we can find them by:

Position[pairs, 
 Alternatives @@ 
  Table[ReplacePart[SOMEPAIR, i -> _], {i, 3}], {1}]

If we extend this code further, we could build an AdjacencyMatrix in which we want to select a minimum set of nodes that are never incident to the same edge (like FindIndependentVertexSet but in minimum terms):

graphRules = 
  DeleteDuplicatesBy[Sort]@
   Catenate@
    Table[Thread[
      index \[UndirectedEdge] 
       Catenate@
        Position[pairs, 
         Alternatives @@ 
          Table[ReplacePart[pairs[[index]], i -> _], {i, 
            3}], {1}]], {index, Length@pairs}];

adjacency = Unitize@AdjacencyMatrix[graphRules];

Showing the graph:

Graph[graphRules]

Now we find the vertex set:

result = LinearOptimization[
  ConstantArray[1,n],
 {Join[DiagonalMatrix@ConstantArray[1, n], adjacency], 
   Join[ConstantArray[0, n], ConstantArray[-1, n]]}, Integers]

Highlighting the vertex set:

HighlightGraph[graphRules, 
 VertexList[graphRules][[Catenate@Position[result, 1]]]]

The red vertices in the above graph are the pairs you're looking for. Each vertex in the graph is either red or is in the neighborhood of a red vertex (aka is a chosen pair or is covered by a chosen pair). If we get the pairs:

pairs[[VertexList[graphRules][[Catenate@Position[result, 1]]]]]

(* Out: {{2, 3, 0}, {1, 2, 0}, {3, 0, 2}, {2, 1, 1}, {0, 1, 2}, {1, 1, 3}} *)