# 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? Commented Mar 2, 2018 at 9:29
• I think I understood what you need, see if my answer works for you. Commented Mar 2, 2018 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? Commented Mar 2, 2018 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. Commented Mar 2, 2018 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. Commented Mar 2, 2018 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. Commented Mar 2, 2018 at 17:09
• Thank you, LLIAMnYP. Your solution is accepted. The bounty is yours. Commented Mar 2, 2018 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. Commented Mar 2, 2018 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. Commented Mar 2, 2018 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. Commented Mar 6, 2018 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 {}. Commented Feb 27, 2018 at 23:53
• @PhillipDukes, does the updated version work?
– kglr
Commented Feb 27, 2018 at 23:55
• yes, this is great. Commented Feb 27, 2018 at 23:58
• please see edited question. Commented Mar 2, 2018 at 3:01
– kglr
Commented Mar 2, 2018 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. Commented Mar 2, 2018 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}} Commented Mar 2, 2018 at 5:35
• @PhillipDukes what's the problem with it? Commented Mar 2, 2018 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. Commented Mar 2, 2018 at 5:44
• @PhillipDukes try now Commented Mar 2, 2018 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}. Commented Mar 2, 2018 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. Commented Mar 2, 2018 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}} Commented Mar 2, 2018 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}} Commented Mar 2, 2018 at 22:03