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 is how:

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, or more precisely these 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}} *)