Find Columns That Match Row Vectors in a Matrix

Question

Suppose I have the following matrix whose row elements are given by the data listed below.

data = {{1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0,
     0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 
    0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0,
     0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 
    1, 1, 1, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 
    0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}};
head = {{S0, S1, S2, S3, S4, S5, S6, S7, S8}, {c1, c2, c3, c4, c5, c6,
     c7, c8, c9, c10, c11, c12, c13, c14, c15, c16}};
Join[Transpose[{Join[{""}, head[[1]]]}], Join[head[[{2}]], data], 
  2] // Grid
rownames = {S0, S1, S2, S3, S4, S5, S6, S7, S8};
colnames = {c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, 
   c14, c15, c16};
groups1 = GroupBy[Thread[rownames -> data], Last -> First]
Values[groups1]

In this case, it turns out that rows (S1, S8), (S2, S3, S4), (S5, S6, S7) as row vectors have equal element values that are associated with certain column names. The above code produces this output

<|{1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} -> {S0}, {0, 0, 0, 
   0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} -> {S1, S8}, {0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0} -> {S2, S3, S4}, {0, 0, 0, 0, 1, 
   0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0} -> {S5, S6, S7}|>

{{S0}, {S1, S8}, {S2, S3, S4}, {S5, S6, S7}}

The output I'm looking for are which columns this output is associated with; specifically, I'm looking for an output like this:

{{{c1}, S0}, {{c6}, S1, S8}, {{c12}, S2, S3, 
  S4}, {{c5, c9, c10, c11, c12}, S5, S6, S7}}

Any help is most appreciated!!

Answer 1

KeyValueMap[{colnames[[#]], ## & @@ #2} &] @
  GroupBy[Thread[rownames -> (PositionIndex[#][1] & /@ data)], Last -> First]

 {{{c1}, S0}, 
  {{c6}, S1, S8}, 
  {{c12}, S2, S3, S4}, 
  {{c5, c9, c10, c11, c12}, S5, S6, S7}}

You can also do:

Values @ GroupBy[Thread[rownames -> (PositionIndex[#][1] & /@ data)], 
  Last, 
 {colnames[[First @ Values @ #]], ## & @@ Keys @ #} &]

same result

Answer 2

Copying over your code

data = {{1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, 
        {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, 
        {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, 
        {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, 
        {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, 
        {0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0}, 
        {0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0}, 
        {0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0}, 
        {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}};

rownames = {S0, S1, S2, S3, S4, S5, S6, S7, S8}

Add the row names to the data, and gather them up by similarity of the data. Grab the row names that are similar.

 datRowNames = Transpose@Prepend[Transpose@data, rownames];
 res = Gather[datRowNames, Rest[#1] == Rest[#2] &];
 r1=Map[First, res, {2}]

(*   {{S0}, {S1, S8}, {S2, S3, S4}, {S5, S6, S7}}  *)

Get the info on which columns are occupied for the particular row names. Break it into steps so you can peer in.

r2 = Map[Rest, res, {2}]; (* strip off the row name from the data elements *)
r3 = Map[First, r2];      (* just get the first of like elements *)
r4 = Map[Position[#, 1] &, r3];  (* mark where their value is '1' *)
r5 = Map[Flatten, r4]          (* flatten it out *)

(*  {{1}, {6}, {12}, {5, 9, 10, 11, 12}} *)

From here it's just a formatting drill.

MapThread[{#1, #2} &, {r5, r1}]

(* {{{1}, {S0}}, {{6}, {S1, S8}}, {{12}, {S2, S3, S4}}, {{5, 9, 10, 11,  12}, {S5, S6, S7}}} *)