5
$\begingroup$

I have a combinations with 3 factors:

{a1,m1,c1}
{a1,m1,c2}
{a1,m2,c1}
{a2,m1,c1}
{a2,m1,c2}

Now I want to "compress" these 5 expressions into as few expressions as possible, in this case 2 is the minimum:

{{c1,c2},{m1},{a1,a2}} 
{{c1},{m2},{a1}}

As we can see, we can easily generate original combinations from the compressed expressions.

My question is how do I generalize an algorithm to compress the combinations to fewest expressions?

I have more complex case with 4 or 5 factors.

I believe there is an existing algorithm for doing this, could you share a link to the algorithm?

Update:

A more general case with 2 factors:

Using 

{a1,a2,a3} {c1,c2,c3}

we can generate

{a1,c1} {a1,c2} {a1,c3}, {a2,c1} {a2,c2} {a2,c3} {a3,c1} {a3,c2} {a3,c3}

How can I deduce 

{{a1,a2,a3},{c1,c2,c3}}

from 

{a1,c1} {a1,c2} {a1,c3}, {a2,c1} {a2,c2} {a2,c3} {a3,c1} {a3,c2} {a3,c3}
|improve this question
$\endgroup$
  • 1
    $\begingroup$ Can you explain what you mean by "compress" in this case? It's pretty unclear from your post how you chose those particular combinations. Is it that you want to be able to generate all of your original lists using, for instance, Tuples[{{a1, a2}, {m1}, {c1, c2}}] and Tuples[{{a1},{m2},{c1}}] with as small a generating set as possible (two in this case)? $\endgroup$ – march Apr 9 at 17:15
  • $\begingroup$ So, the result of the algorithm is meant to be the "inverse" of Union @@ (Tuples /@ result)? $\endgroup$ – Henrik Schumacher Apr 9 at 17:20
  • $\begingroup$ @sfdcnoob: Very interesting question. Is there a reason why you tagged it by "linear-algebra"? That might shed some light on the background of this question and mights also be help to develop an algorithm. Moreover, is there any a priori knowledge about the input data? $\endgroup$ – Henrik Schumacher Apr 9 at 17:23
  • $\begingroup$ this is a coding assignment for my work. I need to build a configuration file. I felt it's somewhat similar to matrix multiplication. $\endgroup$ – sfdcnoob Apr 9 at 18:12
  • $\begingroup$ There is not always a unique way to "compress" the data. For example, {a1,b1} {a1,b2} {a2,b1} can be "compressed" as {{a1},{b1,b2}} {{a2},{b1}} or {{a1,a2},{b1}} {{a1},{b2}} $\endgroup$ – andre314 Apr 9 at 20:17
3
$\begingroup$

One approach is to interpret you list of tuples as a sum of products, and to leverage FullSimplify to group terms:

Let

tuples = {
  {a1, m1, c1},
  {a1, m1, c2},
  {a1, m2, c1},
  {a2, m1, c1},
  {a2, m1, c2}
 };

Now we can transform it into a sum of products and simplify:

Plus @@ Times @@@ tuples
(* a1 c1 m1 + a2 c1 m1 + a1 c2 m1 + a2 c2 m1 + a1 c1 m2 *)

% // FullSimplify
(* (a1 + a2) (c1 + c2) m1 + a1 c1 m2 *)

(* replace Plus and Times with List again *)
% // ReplaceAll[Times | Plus -> List]
(* {{{a1, a2}, {c1, c2}, m1}, {a1, c1, m2}} *)

(* clean the result up a bit by ensuring that also the one-element cases are lists *)
% // Map[Flatten@*List, #, {2}] &
(* {{{a1, a2}, {c1, c2}, {m1}}, {{a1}, {c1}, {m2}}} *)

The same works for your other example:

tuples2 = {{a1, c1}, {a1, c2}, {a1, c3}, {a2, c1},
 {a2, c2}, {a2, c3}, {a3, c1}, {a3, c2}, {a3, c3}};

Map[Flatten@*List, FullSimplify[Plus @@ Times @@@ tuples2] /. Times | Plus -> List, {2}]
(* {{{a1, a2}, {c1, c2}, {m1}}, {{a1}, {c1}, {m2}}} *)

Of course, this might not work in all cases, and it will not respect the order of terms, but depending on what you need, this is already good enough.

Order preserving version

In case the order of the elements is important, here is an order-preserving version:

(
  SortBy[First@*First] /@
   Map[
    Flatten@*List,
    FullSimplify[Plus @@ Times @@@ MapIndexed[Construct] /@ tuples2] /. Times | Plus -> List,
    {2}
    ]
  )[[All, All, All, 0]]

The basic idea is the same, but this time we keep track of the initial positions of the elements in the lists, and use those to sort the elements again after simplification.

|improve this answer
$\endgroup$
  • $\begingroup$ thank you! this looks elegant, but can I use this library in golang? $\endgroup$ – sfdcnoob Apr 9 at 19:53
  • $\begingroup$ Wow this is brilliant! For preserving the order you could also have in the first line Plus @@ NonCommutativeMultiply @@@ tuples, in the second line FullSimplify[%, TransformationFunctions -> {Automatic, # /. u1_ ** v_ + u2_ ** v_ -> (u1 + u2) ** v &, # /. u_ ** v1_ + u_ ** v2_ -> u ** (v1 + v2) &}], and in the third line % // ReplaceAll[NonCommutativeMultiply | Plus -> List]. $\endgroup$ – Roman Apr 9 at 20:05
  • $\begingroup$ @Roman Thanks for the suggestion to use NonCommutativeMultiply, but unfortunately I can't get it to work for some reason. (Not even by directly copying your code) $\endgroup$ – Lukas Lang Apr 10 at 10:36
  • $\begingroup$ @sfdcnoob What do you mean by that? What library? What does golang have to do with it? $\endgroup$ – Lukas Lang Apr 10 at 10:36
  • $\begingroup$ @LukasLang you're right it doesn't work, I hadn't tried enough examples. I can't figure out the necessary TransformationFunctions to make it work. Never mind. $\endgroup$ – Roman Apr 10 at 12:03
2
$\begingroup$

Here's a solution that recursively searches for the largest subset combination that is contained in the set:

cover[{}] = {};
cover[L_List] := Module[{u, n, uu, s, t, a, LL},
  (* list the unique elements in each column *)
  u = Union /@ Transpose[L];
  (* the number of columns *)
  n = Length[u];
  (* all subsets of the elements in u *)
  uu = Subsets[#, {1, ∞}] & /@ u;
  (* all combinations of such subsets and the resulting elements *)
  s = Flatten[Outer[List, Sequence @@ uu, 1], n - 1];
  (* pick out those subset combinations that are fully contained in L *)
  t = Select[s, SubsetQ[L, Flatten[Outer[List, Sequence @@ #], n - 1]] &];
  (* pick the largest one *)
  a = First[MaximalBy[t, Length[Flatten[#]] &, 1]];
  (* which elements of L aren't covered yet? *)
  LL = Complement[L, Flatten[Outer[List, Sequence @@ a, 1], n - 1]];
  (* recurse *)
  Prepend[cover[LL], a]]

test:

cover[{{a1, m1, c1}, {a1, m1, c2}, {a1, m2, c1}, {a2, m1, c1}, {a2, m1, c2}}]

{{{a1, a2}, {m1}, {c1, c2}}, {{a1}, {m2}, {c1}}}

cover[{{a1, c1}, {a1, c2}, {a1, c3}, {a2, c1}, {a2, c2}, {a2, c3}, {a3, c1}, {a3, c2}, {a3, c3}}]

{{{a1, a2, a3}, {c1, c2, c3}}}

Same but with the last element removed:

cover[{{a1, c1}, {a1, c2}, {a1, c3}, {a2, c1}, {a2, c2}, {a2, c3}, {a3, c1}, {a3, c2}}]

{{{a1, a2}, {c1, c2, c3}}, {{a3}, {c1, c2}}}

|improve this answer
$\endgroup$
0
$\begingroup$

Here is a code that works but needs a lot of memory
a in your example is {{a1,a2},{m1,m2},{c1,c2}} and
s in your example is {{a1,m1,c1},{a1,m1,c2},{a1,m2,c1},{a2,m1,c1},{a2,m1,c2}}

since this needs a lot of memory here is how it works on a={{a1,a2},{c1,c2}} 

a = {{a1, a2}, {c1, c2}};
s = {{a1, c2}, {a2, c2}};
First@Select[Subsets[Tuples[Rest@Subsets[#]&/@a]],Union@Flatten[Tuples/@#,1]==s&]

{{{a1, a2}, {c2}}}

for 

s = {{a1, c1}, {a2, c2}};

{{{a1}, {c1}}, {{a2}, {c2}}}

|improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.