# Given list of associations, generate a list of all common associations

Given a list of parameters and associated values, how can I generate a list of all common associations? For instance, given

list = {{AA, 3}, {AB, 2}, {AB, 4}, {BA, 2}, {BA, 5}, {BB, 6}};


I want to obtain

{{AA, 3}, {AB, {2, 4}}, {BA, {2, 5}}, {{AB, BA}, 2}, {BB, 6}}


(Edit) Both answers from both kglr and mef will break down under certain circumstances, eg., When

list = {{{15, "->", 15}, 3}, {{15, "->", 15}, 8}, {{16, "->", 16}, 2}, {{16,"->", 16}, 3}, {{16, "->", 16}, 4}, {{16, "->", 16}, 5}, {{16, "->", 16}, 6}, {{16, "->", 16}, 7}, {{16, "->", 16}, 8}}


the solution from kglr gives

{{{15, "->", 15}, {3, 8}}, {{16, "->", 16}, {2, 3, 4, 5, 6, 7, 8}}, {{{15, "->", 15}, {16, "->", 16}}, 3}}


and the solution from mef gives

{{{15, "->", 15}, {3, 8}}, {{16, "->", 16}, {2, 3, 4, 5, 6, 7, 8}}, {{{15, "->", 15}, {16, "->", 16}}, 8}}


where the desired result is

{{{15, "->", 15}, {3, 8}}, {{16, "->", 16}, {2, 3, 4, 5, 6, 7, 8}}, {{{15, "->", 15}, {16, "->", 16}}, {3, 8}}}


(Edit #2) It may be helpful if I describe what I’m actually looking at. Given a list labeled graphs of order n which includes a mix of graphs which are pairwise either isomorphic or non-isomorphic, and each graph is uniquely identified by a number

listGi ={1,2,3,…};


Each labeled graph Gi has a Kirchhoff matrix which is invariant to some transformation from the permutation group.

KirchhoffMatrix[Gi] == Pj.KirchhoffMatrix[Gi].Transpose[Pj];


Each element of the permutation group is also uniquely identified by a number,

Pj = {1,2,3,…};


I then have a list of each Gi “associated” with an element of the permutation group which leaves its Kirchhoff matrix invariant (I ignore the identity element of the permutation group). For example, in a particular mix of graphs which are pairwise either isomorphic or non-isomorphic I have

listA = {{{1 -> 1}, 17}, {{2->2}, 17}, {{3->3}, 24}, {{4->4}, 24}, {{5->5}, 8}, {{6->6}, 17}, {{7->7}, 8}, {{8->8}, 2}, {{8->8}, 7}, {{8->8}, 8}, {{8->8}, 17}, {{8->8}, 18}, {{8->8}, 23}, {{8->8, 24}, {{9-9}, 6}, {{9-9}, 8}, {{9-9}, 10}, {{9-9}, 15}, {{9-9}, 17}, {{9-9}, 19}, {{9-9}, 24}};


What I want is a list of the Gi’s which are invariant to common Pj’s. And the list of all the P’j that leave KirchhoffMatrix[Gi] invariant which are not specified in the first instance. (LLIAMnYP describes this more rigorously with his analogy of sub-matrices.) For input listA above my desired output is:

{{{8->8}, {9->9}, {8, 17, 24}}, {{8->8}, {2,7,8,17,18,23,24}}, {{9->9},{6,8,10,15,17,19,24}}, {{{3->3},{4->4},{8,8},{9,9}}, 24}, {{{5->5},{7->7},{8->8},{9->9}}, {8}}, {{{1->1},{2->2},{6->6},{8->8},{9->9}}, 17}}


This solution is correctly obtained by LLIAMnYP in his answer. I thought I could get my point across with a single example, but I was wrong! When I repeatedly pointed out where proposed answers did not do what I wanted, I was accused of continuously changing the problem. Not true, I had to change the specific example of listA to show that the proposed answers were not solving the problem. My many thanks to LLIAMnYP for his insight and diligence to finally understand and solve my question. I am surprised that the solution proved to be as difficult as it was. And, again, I thought I could communicate the problem with a single simple example. Mr.Wizard proposed a solution which did not give the correct result. However his proposed solution did give results which were not part of my original quest, which, however, I found interesting in retrospect. His solution included those Pj which were unique to a Gi and were not otherwise included in the output list. For instance, an example from listA above, {Pj} = {2,7,18,23} are unique to {8->8}. If anyone could pose a solution which does the same thing as LLIAMnYP’s answer and included these unique “associations”, I would be grateful. I can visually compare an example input listA (one that is not too long, anyway) with the output list and see if it produces my desired output. My desired result is not ambiguous, apparently it is just tricky to describe.

• This problem resembles factoring common multipliers out. What I do not understand, is why {AB, {2, 4}} and {BA, {2, 5}} and {{AB, BA}, 2} are present. Would just {AB, 4}, {BA, 5}, {{AB, BA}, 2} not work? – LLlAMnYP Mar 2 '18 at 9:29
• I think I understood what you need, see if my answer works for you. – LLlAMnYP Mar 2 '18 at 9:52
• Philipp, my friend: Is this a guessing game or what? How about a precise problem description instead of this trial and error game? – Henrik Schumacher Mar 2 '18 at 17:10
• Phillip, more than half a dozen not completely dumb people are wasting their time to guess what you might mean. Really, there must be something vague about your question. Examples are not a form of a precise problem description. For a start: What do you mean with "all common associations"? There are actually no associations at all in your input examples. – Henrik Schumacher Mar 2 '18 at 18:56
• @Henrik I understand your frustration, since this problem has many edge cases. Part of the answer is to ask the right question, which can be hard when the edge cases are so plentiful. I think we can show some compassion here. – LLlAMnYP Mar 2 '18 at 22:09

commonAssociations[list_] :=
Module[{assoc = Merge[Association@*Rule @@@ list, Union], keys, vals,
result},
keys = Rest@Subsets[Keys@assoc];
vals = Intersection @@@ Map[assoc, keys, {2}];
result = DeleteCases[Thread[{keys, vals}], {_, {}}];
Map[If[Length@# == 1, #[[1]], #] &, result, {2}]
]


This works on both your test cases.

For the second one:

list = {{{15, "->", 15}, 3}, {{15, "->", 15}, 8}, {{16, "->", 16}, 2},
{{16, "->", 16}, 3}, {{16, "->", 16}, 4}, {{16, "->", 16}, 5},
{{16, "->", 16}, 6}, {{16, "->", 16}, 7}, {{16, "->", 16}, 8}};
commonAssociations[list]

{{{15, "->", 15}, {3, 8}}, {{16, "->", 16}, {2, 3, 4, 5, 6, 7, 8}},
{{{15, "->", 15}, {16, "->", 16}}, {3, 8}}}


Explanation:
As I understand, the input is a list of pairs {{key1, value1}, ...}. First we group values associated to each key (Merge[Association@*Rule @@@ list, Union]).

Common associations I interpret as values common to more than one key. So I take all possible subsets of the keys keys = Rest@Subsets[Keys@assoc]; then get the values associated to each of these subsets Map[assoc, keys, {2}] then extract those values, which where common for every key in the subset by taking the intersection of the lists of values (Intersection@@@).

Finally, I delete associations to subsets of keys that had no common element (that is { set_of_keys, {(*no values here*)}}) which are matched by the pattern {_, {}}) and then replace all lists of length 1 by their only element.

Update 05.03.18
My algorithm above, unfortunately, grows exponentially with the number of keys (there are 2^n subsets of n keys). For the examples provided by OP the number of keys was quite small, but for a general solution a different approach is probably in order. Before going on, I'd acknowledge that I do not have a solution to this right now, but there is an alternative take to this problem which may be of interest: let's take a new example list that was provided in a comment:

list =
{{{14, "->", 14}, 6}, {{14, "->", 14}, 8}, {{14, "->", 14}, 10},
{{15, "->", 15}, 3}, {{15, "->", 15}, 8}, {{15, "->", 15}, 11},
{{16, "->", 16}, 2}, {{16, "->", 16}, 3}, {{16, "->", 16}, 4},
{{16, "->", 16}, 5}, {{16, "->", 16}, 6}, {{16, "->", 16}, 7},
{{16, "->", 16}, 8}, {{16, "->", 16}, 9}, {{16, "->", 16}, 10},
{{16, "->", 16}, 11}, {{16, "->", 16}, 12}}


I'm not particularly interested in what exactly the keys and values are, so I'll simply enumerate them with a helper function:

Block[{key, val, k = 0, v = 0},
key[x_] := key[x] = ++k; val[x_] := val[x] = ++v; {key@#1, val@#2} & @@@ list]

{{1, 1}, {1, 2}, {1, 3}, {2, 4}, {2, 2}, {2, 5}, {3, 6}, {3, 4},
{3, 7}, {3, 8}, {3, 1}, {3, 9}, {3, 2}, {3, 10}, {3, 3}, {3, 5}, {3, 11}}

MatrixPlot@SparseArray@Thread[% -> 1]


So In a way, what the OP wants, is to pick out the largest sub-matrices of this matrix which are

• filled with ones.
• cover all the non-zero entries of the original matrix
• and no sub-matrix should be the sub-matrix of another one.

My algorithm failed here, since it generates redundantly e.g. the following associations:

{{1, 2}, 2}
{{1, 2, 3}, 2}


This is easily fixed by adding an extra step to my algorithm:

commonAssociations[list_] :=
Module[{assoc = Merge[Association@*Rule @@@ list, Union], keys, vals,
result},
keys = Rest@Subsets[Keys@assoc];
vals = Intersection @@@ Map[assoc, keys, {2}];
result = DeleteCases[Thread[{keys, vals}], {_, {}}];
result = Union@@@GroupBy[result, Last -> First];
Map[If[Length@# == 1, #[[1]], #] &, result, {2}]
]


Since the order of key-value pairs doesn't matter, one can, at the very least, write a helper function that will automatically reverse the key-value pairs, so as to work with the subsets of the smaller set of the two.

Update 06.03.18
Having shown, that this problem amounts to selecting a number of submatrices, I find that

is very relevant here. However, I still do not see a trivial way to move forward here.

• This is the best solution I've seen so far. The only problem is if list = {{{14, "->", 14}, 6}, {{14, "->", 14}, 8}, {{14, "->", 14}, 10}, {{15, "->", 15}, 3}, {{15, "->", 15}, 8}, {{15, "->", 15}, 11}, {{16, "->", 16}, 2}, {{16, "->", 16}, 3}, {{16, "->", 16}, 4}, {{16, "->", 16}, 5}, {{16, "->", 16}, 6}, {{16, "->", 16}, 7}, {{16, "->", 16}, 8}, {{16, "->", 16}, 9}, {{16, "->", 16}, 10}, {{16, "->", 16}, 11}, {{16, "->", 16}, 12}}, it includes {{{14, "->", 14}, {15, "->", 15}}, 8} and {{{14, "->", 14}, {15, "->", 15}, {16, "->", 16}}, 8}}, only the later is desired. – Phillip Dukes Mar 2 '18 at 17:09
• Thank you, LLIAMnYP. Your solution is accepted. The bounty is yours. – Phillip Dukes Mar 2 '18 at 19:23
• @Phillip I think I see what you mean, but I don't have MMA handy right now. I'll check it out Monday. – LLlAMnYP Mar 2 '18 at 22:03
• Thank you for your contribution. I have been able to further process the output of this answer to obtain what I want to see. I would be interested to see your final solution. – Phillip Dukes Mar 2 '18 at 22:30
• @tomd I'm not fond of the way the problem is specified. I don't have a rigorous definition for the core problem, let alone the specifics of the I/O formatting, but I found the former interesting, while I have little interest for digging into the latter. – LLlAMnYP Mar 6 '18 at 13:36
gather[x_] := {#[[1, 1]], #[[All, -1]]}& /@ Join[GatherBy[x, First],
GatherBy[{#[[All, 1]], #[[1, -1]]}&/@ Select[GatherBy[x, Last], Length@# >1&], First]] /.
{{} -> Sequence[], {a_, {y_}} :> {a, y}}

gather @ list


{{AA, 3}, {AB, {2, 4}}, {BA, {2, 5}}, {BB, 6}, {{AB, BA}, 2}}

gather @ list2


{{{15, "->", 15}, {3, 8}}, {{16, "->", 16}, {2, 3, 4, 5, 6, 7, 8}}, {{{15, "->", 15}, {16, "->", 16}}, {3, 8}}}

• yes this is close , but there are logical duplications and unnecessary {}. – Phillip Dukes Feb 27 '18 at 23:53
• @PhillipDukes, does the updated version work? – kglr Feb 27 '18 at 23:55
• yes, this is great. – Phillip Dukes Feb 27 '18 at 23:58
• please see edited question. – Phillip Dukes Mar 2 '18 at 3:01
• @Philip, updated the answer. – kglr Mar 2 '18 at 11:40

Here is an alternative approach. It relies on Merge. It works with the example, but I'm not sure it's fully general.

rlist = Rule @@@ list


Here are the functions used in the merges:

fun1 = If[Length[#] == 1, #[[1]], #] &
fun2 = Sort[#][[-1]] &


Here's the main part:

List @@@
Normal @
Merge[{
Normal @ Merge[rlist, fun1],
Reverse /@ Normal @ Merge[Reverse /@ rlist, fun1]
},
fun2
]

• please see edited question. – Phillip Dukes Mar 2 '18 at 3:00
list = {{AA, 3}, {AB, 2}, {AB, 4}, {BA, 2}, {BA, 5}, {BB, 6}};
list2 = {{{15, "->", 15}, 3}, {{15, "->", 15}, 8}, {{16, "->", 16},
2}, {{16, "->", 16}, 3}, {{16, "->", 16}, 4}, {{16, "->", 16},
5}, {{16, "->", 16}, 6}, {{16, "->", 16}, 7}, {{16, "->", 16}, 8}};

list3 = {{{1, "->", 1}, 8}, {{3, "->", 3}, 8}, {{10, "->", 10},
8}, {{12, "->", 12}, 8}, {{13, "->", 13}, 2}, {{13, "->", 13},
7}, {{13, "->", 13}, 8}, {{14, "->", 14}, 6}, {{14, "->", 14},
8}, {{15, "->", 15}, 3}, {{15, "->", 15}, 8}, {{16, "->", 16},
2}, {{16, "->", 16}, 3}, {{16, "->", 16}, 4}, {{16, "->", 16},
5}, {{16, "->", 16}, 6}, {{16, "->", 16}, 7}, {{16, "->", 16},
8}};

fun[lista_List] := Module[{as1, as4,as5}
,
as1 = GroupBy[lista, First -> Last];
as4 = Select[Reverse@GroupBy[lista, Last -> First], Length[#] > 1 &];
as5 = Merge[Association[Thread[Subsets[Lookup[as4, #], {2}] -> #]] & /@ Keys@as4, Identity];

{#[[1]], Sort[#[[2]]]} & /@  Transpose[{Keys[#], List @@ Normal @@@ #}] &@ Merge[{as1, as5}, Identity]]

fun[list2]


gives me :

{{15, "->", 15}, {3, 8}}, {{16, "->", 16}, {2, 3, 4, 5, 6, 7, 8}}, {{{15, "->", 15}, {16, "->", 16}}, {3,8}}}

while

Grid@fun[list3]


gives me:

{{{1, "->", 1}, {8}}, {{3, "->", 3}, {8}}, {{10, "->", 10}, {8}}, {{12, "->", 12}, {8}}, {{13, "->", 13}, {2, 7, 8}}, {{14, "->", 14}, {6, 8}}, {{15, "->", 15}, {3, 8}}, {{16, "->", 16}, {2, 3, 4, 5, 6, 7, 8}}, {{{15, "->", 15}, {16, "->", 16}}, {3, 8}}, {{{14, "->", 14}, {16, "->", 16}}, {6, 8}}, {{{13, "->", 13}, {16, "->", 16}}, {2, 7, 8}}, {{{1, "->", 1}, {3, "->", 3}}, {8}}, {{{1, "->", 1}, {10, "->", 10}}, {8}}, {{{1, "->", 1}, {12, "->", 12}}, {8}}, {{{1, "->", 1}, {13, "->", 13}}, {8}}, {{{1, "->", 1}, {14, "->", 14}}, {8}}, {{{1, "->", 1}, {15, "->", 15}}, {8}}, {{{1, "->", 1}, {16, "->", 16}}, {8}}, {{{3, "->", 3}, {10, "->", 10}}, {8}}, {{{3, "->", 3}, {12, "->", 12}}, {8}}, {{{3, "->", 3}, {13, "->", 13}}, {8}}, {{{3, "->", 3}, {14, "->", 14}}, {8}}, {{{3, "->", 3}, {15, "->", 15}}, {8}}, {{{3, "->", 3}, {16, "->", 16}}, {8}}, {{{10, "->", 10}, {12, "->", 12}}, {8}}, {{{10, "->", 10}, {13, "->", 13}}, {8}}, {{{10, "->", 10}, {14, "->", 14}}, {8}}, {{{10, "->", 10}, {15, "->", 15}}, {8}}, {{{10, "->", 10}, {16, "->", 16}}, {8}}, {{{12, "->", 12}, {13, "->", 13}}, {8}}, {{{12, "->", 12}, {14, "->", 14}}, {8}}, {{{12, "->", 12}, {15, "->", 15}}, {8}}, {{{12, "->", 12}, {16, "->", 16}}, {8}}, {{{13, "->", 13}, {14, "->", 14}}, {8}}, {{{13, "->", 13}, {15, "->", 15}}, {8}}, {{{14, "->", 14}, {15, "->", 15}}, {8}}}

• this is an improvement, but try list2 = {{{1, "->", 1}, 8}, {{3, "->", 3}, 8}, {{10, "->", 10}, 8}, {{12, "->", 12}, 8}, {{13, "->", 13}, 2}, {{13, "->", 13}, 7}, {{13, "->", 13}, 8}, {{14, "->", 14}, 6}, {{14, "->", 14}, 8}, {{15, "->", 15}, 3}, {{15, "->", 15}, 8}, {{16, "->", 16}, 2}, {{16, "->", 16}, 3}, {{16, "->", 16}, 4}, {{16, "->", 16}, 5}, {{16, "->", 16}, 6}, {{16, "->", 16}, 7}, {{16, "->", 16}, 8}} – Phillip Dukes Mar 2 '18 at 5:35
• @PhillipDukes what's the problem with it? – Alucard Mar 2 '18 at 5:39
• For {{15, "->", 15}, {16, "->", 16}} it should have {3,8}. I find the output to be more readable when displayed in Grid format. – Phillip Dukes Mar 2 '18 at 5:44
• @PhillipDukes try now – Alucard Mar 2 '18 at 9:02

I'm not entirely clear on what you want but I think this might be it, and fairly cleanly.

list = {{"dog", 3}, {"dog", 8}, {"cat", 2}, {"cat", 3}, {"cat", 4},
{"cat", 5}, {"cat", 6}, {"cat", 7}, {"cat", 8}, {"bird", 7}};


Note the inclusion of {"bird", 7} as there is no analog in your example.

m = Normal @* Merge[Identity];
mr = m @ Reverse[#, 2] &;
rls = Rule @@@ list;

m @ rls
mr @ mr @ rls

{"dog" -> {3, 8}, "cat" -> {2, 3, 4, 5, 6, 7, 8}, "bird" -> {7}}

{{"dog", "cat"} -> {3, 8}, {"cat"} -> {2, 4, 5, 6}, {"cat", "bird"} -> {7}}


My question to you is which parts of the second output line do you want to keep?

• Try {{"dog", 6}, {"dog", 8}, {"dog", 10}, {"cat", 3}, {"cat", 8}, {"cat", 11}, {"bird", 2}, {"bird", 3}, {"bird", 4}, {"bird", 5}, {"bird", 6}, {"bird", 7}, {"bird", 8}, {"bird", 9}, {"bird", 10}, {"bird", 11}, {"bird", 12}}, should output {"dog", "bird"} -> {6, 8, 10}. – Phillip Dukes Mar 2 '18 at 17:27
• @Phillip But nothing for {"cat", "bird"}, {"dog", "cat", "bird"}, etc.? How is that determined? I think I understand your complaint, that 8 does not appears in the list for {"dog", "bird"}, but that's an artifact of how I interpreted this, apparently wrongly. – Mr.Wizard Mar 2 '18 at 21:04
• Yes, your are right. I'm am just trying to concisely point out an example of an omission. The FULL output should be {{"dog", "bird"} -> {6, 10}, {"dog", "cat", "bird"} -> {8}, {"cat", "bird"} -> {3, 11}, {"bird"} -> {2, 4, 5, 7, 9, 12}} – Phillip Dukes Mar 2 '18 at 21:26

Using

atomizeSingleton = ReplaceAll[{x_} :> x];


The query:

list  // Query[{GroupBy[First -> Last] /* atomizeSingleton,
GroupBy[Last -> First] /* atomizeSingleton /* Normal /*
Map[Reverse] /* Association} /* Merge[Flatten /* Union]] //
KeyValueMap[List /* atomizeSingleton]


{{AA, 3}, {AB, {2, 4}}, {BA, {2, 5}}, {BB, 6}, {{AB, BA}, 2}}

(Edit) Second Attempt

list

(list // Rest@Subsets[DeleteDuplicates[#[[All, 1]]]] & // (Transpose[{#,
Intersection @@@ Join[# /. GroupBy[list, First -> Last]]}] /. {x_} ->
x) &) /. {{x__}, {}} -> Nothing


{{AA, 3}, {AB, {2, 4}}, {BA, {2, 5}}, {BB, 6}, {{AB, BA}, 2}}

Or as a function

assocs := Function[x, (x // Rest@Subsets[DeleteDuplicates[#[[All, 1]]]] &
// (Transpose[{#,
Intersection @@@
Join[# /. GroupBy[x, First -> Last]]}] /. {x_} ->
x) &) /. {{x__}, {}} -> Nothing]


list2

assocs@list2


{{{15, "->", 15}, {3, 8}}, {{16, "->", 16}, {2, 3, 4, 5, 6, 7, 8}}, {{{15, "->", 15}, {16, "->", 16}}, {3, 8}}}

list3

assocs@list3


{{"dog", 8}, {"cat", {2, 7, 8, 17, 18, 23, 24}}, {"bird", {6, 8, 10, 15, 17, 19, 24}}, {"rat", {3, 8, 11, 14, 17, 22, 24}}, {"man", {2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23}}, {{"dog", "cat"}, 8}, {{"dog", "bird"}, 8}, {{"dog", "rat"}, 8}, {{"dog", "man"}, 8}, {{"cat", "bird"}, {8, 17, 24}}, {{"cat", "rat"}, {8, 17, 24}}, {{"cat", "man"}, {2, 7, 8, 17, 18, 23}}, {{"bird", "rat"}, {8, 17, 24}}, {{"bird", "man"}, {6, 8, 10, 15, 17, 19}}, {{"rat", "man"}, {3, 8, 11, 14, 17, 22}}, {{"dog", "cat", "bird"}, 8}, {{"dog", "cat", "rat"}, 8}, {{"dog", "cat", "man"}, 8}, {{"dog", "bird", "rat"}, 8}, {{"dog", "bird", "man"}, 8}, {{"dog", "rat", "man"}, 8}, {{"cat", "bird", "rat"}, {8, 17, 24}}, {{"cat", "bird", "man"}, {8, 17}}, {{"cat", "rat", "man"}, {8, 17}}, {{"bird", "rat", "man"}, {8, 17}}, {{"dog", "cat", "bird", "rat"}, 8}, {{"dog", "cat", "bird", "man"}, 8}, {{"dog", "cat", "rat", "man"}, 8}, {{"dog", "bird", "rat", "man"}, 8}, {{"cat", "bird", "rat", "man"}, {8, 17}}, {{"dog", "cat", "bird", "rat", "man"}, 8}}

list4

assocs@list4


{{"dog", {6, 8, 10}}, {"cat", {3, 8, 11}}, {"bird", {2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}}, {{"dog", "cat"}, 8}, {{"dog", "bird"}, {6, 8, 10}}, {{"cat", "bird"}, {3, 8, 11}}, {{"dog", "cat", "bird"}, 8}}

where:

list = {{AA, 3}, {AB, 2}, {AB, 4}, {BA, 2}, {BA, 5}, {BB, 6}};
list2 = {{{15, "->", 15}, 3}, {{15, "->", 15}, 8}, {{16, "->", 16},
2}, {{16, "->", 16}, 3}, {{16, "->", 16}, 4}, {{16, "->", 16},
5}, {{16, "->", 16}, 6}, {{16, "->", 16}, 7}, {{16, "->", 16},
8}};
list3 = {{"dog", 8}, {"cat", 2}, {"cat", 7}, {"cat", 8}, {"cat",
17}, {"cat", 18}, {"cat", 23}, {"cat", 24}, {"bird", 6}, {"bird",
8}, {"bird", 10}, {"bird", 15}, {"bird", 17}, {"bird",
19}, {"bird", 24}, {"rat", 3}, {"rat", 8}, {"rat", 11}, {"rat",
14}, {"rat", 17}, {"rat", 22}, {"rat", 24}, {"man", 2}, {"man",
3}, {"man", 4}, {"man", 5}, {"man", 6}, {"man", 7}, {"man",
8}, {"man", 9}, {"man", 10}, {"man", 11}, {"man", 12}, {"man",
13}, {"man", 14}, {"man", 15}, {"man", 16}, {"man", 17}, {"man",
18}, {"man", 19}, {"man", 20}, {"man", 21}, {"man", 22}, {"man",
23}};
list4 = {{"dog", 6}, {"dog", 8}, {"dog", 10}, {"cat", 3}, {"cat",
8}, {"cat", 11}, {"bird", 2}, {"bird", 3}, {"bird", 4}, {"bird",
5}, {"bird", 6}, {"bird", 7}, {"bird", 8}, {"bird", 9}, {"bird",
10}, {"bird", 11}, {"bird", 12}};


(I still think this is the most reasonable interpretation of the OP question as posted.)

(list // KeyValueMap[{##} &, Merge[{KeyMap[List, GroupBy[#, {First -> Last}]],
PositionIndex[GroupBy[#, Last -> First]]}, DeleteDuplicates@*Flatten]] &) /. {x_} -> x


{{AA, 3}, {AB, {2, 4}}, {BA, {2, 5}}, {BB, 6}, {{AB, BA}, 2}}

list // Merge[{KeyMap[List, GroupBy[#, {First -> Last}]],
PositionIndex[GroupBy[#, Last -> First]]}, DeleteDuplicates@*Flatten] &


<|{AA} -> {3}, {AB} -> {2, 4}, {BA} -> {2, 5}, {BB} -> {6}, {AB, BA} -> {2}|>

• try {{"dog", 8}, {"cat", 2}, {"cat", 7}, {"cat", 8}, {"cat", 17}, {"cat", 18}, {"cat", 23}, {"cat", 24}, {"bird", 6}, {"bird", 8}, {"bird", 10}, {"bird", 15}, {"bird", 17}, {"bird", 19}, {"bird", 24}, {"rat", 3}, {"rat", 8}, {"rat", 11}, {"rat", 14}, {"rat", 17}, {"rat", 22}, {"rat", 24}, {"man", 2}, {"man", 3}, {"man", 4}, {"man", 5}, {"man", 6}, {"man", 7}, {"man", 8}, {"man", 9}, {"man", 10}, {"man", 11}, {"man", 12}, {"man", 13}, {"man", 14}, {"man", 15}, {"man", 16}, {"man", 17}, {"man", 18}, {"man", 19}, {"man", 20}, {"man", 21}, {"man", 22}, {"man", 23}} – Phillip Dukes Mar 2 '18 at 22:03