3
$\begingroup$

I have a large tuple and I want to elements of the tuples into groups of 6 elements like this:

{{a1, a2, a3, a4, a5, a6, a7, a8}, {a3, a2, a1, a6, a5, a4, a8, 
  a7}, {-a1 - a3, a2, a1, -a4 - a6, a5, a4, -a7 - a8, a7}, {a1, 
  a2, -a1 - a3, a4, a5, -a4 - a6, a7, -a7 - a8}, {-a1 - a3, a2, 
  a3, -a4 - a6, a5, a6, -a7 - a8, a8}, {a3, a2, -a1 - a3, a6, 
  a5, -a4 - a6, a8, -a7 - a8}}.

This is the input and output samples but with a small number of elements.

inputTup = {{1, 2, 3, 4, 5, 6, 7, 8}, {3, 2, 1, 6, 5, 4, 8, 7}, {-4, 
    2, 1, -10, 5, 4, -15, 7}, {1, 2, -4, 4, 5, -10, 7, -15}, {-4, 2, 
    3, -10, 5, 6, -15, 8}, {3, 2, -4, 6, 5, -10, 8, -15}, {1, 2, 3, 4,
     5, 6, 8, 8} , {1, 1, 3, 4, 5, 6, 7, 8}};
outputSample = {{1, 2, 3, 4, 5, 6, 7, 8}, {3, 2, 1, 6, 5, 4, 8, 
    7}, {-4, 2, 1, -10, 5, 4, -15, 7}, {1, 2, -4, 4, 5, -10, 
    7, -15}, {-4, 2, 3, -10, 5, 6, -15, 8}, {3, 2, -4, 6, 5, -10, 
    8, -15}};

How can I do it? I thought about Gather function but still not able to implement it with this large selection conditions like this.

EDIT:

As it seems like my question not clear enough, I will give another example of simpler problem but of same form.

Assume that I have a list of list like this. The list here has 8 sublists but in reality there are much more.

input = {{1, 2, 3}, {1, 0, 1}, {-2, 1, 3}, {1, -2, 3}, {0, 1, 1}, {1, 0, 
  1}, {1, 0, 0}, {1, 2, 5}}

Now I want to group tuples of the form below into groups:

{{a1, a2, a3}, {-a2, a1, a3}, {a1, -a2, a3}}

where a1, a2, a3 can be any number.

And this is the desired output. Notice that there are two groups satisfying the condition above.

output ={{{1, 2, 3}, {-2, 1, 3}, {1, -2, 3}}, {{1, 0, 1}, {0, 1, 1}, {1, 0, 
   1}}, {1, 0, 0}, {1, 2, 5}}

Two groups satisfying the condition above:

group1 = {{1, 2, 3}, {-2, 1, 3}, {1, -2, 3}}
group2 = {{1, 0, 1}, {0, 1, 1}, {1, 0, 1}}
$\endgroup$
6
  • $\begingroup$ I am not sure I follow. In your inputTup you have eight lists and in your outputSample you have six lists. The first six lists in inputTup are equivalent to the six lists in outputSample. You are wondering how to go from inputTup to outputSample? Or you are wondering how to take a generic list of eight elements (a1->a8) and then create a list of lists, where the a1->a8 elements are ordered as specified in each sublist? $\endgroup$
    – a20
    Commented Dec 9, 2021 at 13:24
  • $\begingroup$ @a20 you could take the other two elements into the outputSample. I removed it to make it clear that I want to group the input into groups of groups where each group is of the form given in the first code box. The length of input list is large which could be 10000 elements. $\endgroup$
    – emnha
    Commented Dec 9, 2021 at 13:29
  • $\begingroup$ Are the elements of the lists always integers, or at least always numeric? $\endgroup$
    – march
    Commented Dec 9, 2021 at 19:48
  • $\begingroup$ @march yes, integers only $\endgroup$
    – emnha
    Commented Dec 9, 2021 at 19:53
  • 2
    $\begingroup$ In addition, is there some obvious symmetry operation whose orbit is the entire set of forms? For example, is there an operation that turns {a1, a2, a3} into {-a2, a1, a3} into {a1, -a2, a3} into {a1, a2, a3}? (I don't think it even needs to be invertible, but that would help.) That way, you can use the operation to define an equivalence relation, and then you'd be able to use Gather or GatherBy with a functionalized version of the operation. $\endgroup$
    – march
    Commented Dec 9, 2021 at 19:55

3 Answers 3

5
$\begingroup$
ClearAll[alikeQ, gatherAlike]
alikeQ[lst_] := Module[{pat = Pattern[#,_] & /@ First[lst], patterns}, 
    patterns[Evaluate @ pat] := lst; 
    MemberQ[patterns @ #, #2]] &;

gatherAlike = Gather[#, alikeQ @ #2] &;

Examples:

OP's first example:

eighttuples = {{a1, a2, a3, a4, a5, a6, a7, a8}, {a3, a2, a1, a6, a5, a4, a8, a7}, 
    {-a1 - a3, a2, a1, -a4 - a6, a5, a4, -a7 - a8, a7},
    {a1, a2, -a1 - a3, a4, a5, -a4 - a6, a7, -a7 - a8},
    {-a1 - a3, a2, a3, -a4 - a6, a5, a6, -a7 - a8, a8}, 
    {a3, a2, -a1 - a3, a6, a5, -a4 - a6, a8, -a7 - a8}};

inputTup = {{1, 2, 3, 4, 5, 6, 7, 8}, {3, 2, 1, 6, 5, 4, 8, 7}, 
    {-4, 2, 1, -10, 5, 4, -15, 7}, {1, 2, -4, 4, 5, -10, 7, -15}, 
    {-4, 2, 3, -10, 5, 6, -15, 8}, {3, 2, -4, 6, 5, -10, 8, -15}, 
    {1, 2, 3, 4, 5, 6, 8, 8}, {1, 1, 3, 4, 5, 6, 7, 8}};

gatherAlike[inputTup, eighttuples] // Column

enter image description here

Select groups with more than one member:

Select[Length @ # > 1 &] @ gatherAlike[inputTup, eighttuples] // Column

enter image description here

OP's second example:

triples = {{a1, a2, a3}, {-a2, a1, a3}, {a1, -a2, a3}};

input = {{1, 2, 3}, {1, 0, 1}, {-2, 1, 3}, {1, -2, 3}, {0, 1, 1}, {1, 0, 1},
   {1, 0, 0}, {1, 2, 5}};

gatherAlike[input, triples] // Column

enter image description here

Select[Length @ # > 1 &] @ gatherAlike[input, triples] // Column

enter image description here

A random example:

thesearealike = {{a1, a2, a3, a4}, {a4, a3, a2, a1}, {a4 + a1, a3, a2, a1 + a4}};

SeedRandom[1]
randominput = DeleteDuplicates@RandomInteger[{1, 4}, {100, 4}];

Length @ randominput
81
Select[Length @ # > 1 &] @ gatherAlike[randominput, thesearealike] // Column

enter image description here

$\endgroup$
2
  • $\begingroup$ If you modify the triple like this triples = {{-a1, a2, a3}, {-a2, a1, a3}, {a1, -a2, a3}}; then gatherAlike[input, triples] you would get an error saying First element in pattern Pattern[-a1,_] is not a valid pattern name. How would you solve this? $\endgroup$
    – emnha
    Commented May 7, 2022 at 15:55
  • $\begingroup$ Or triples = {{-a1+a2, a2, a3}, {-a2, a1, a3}, {a1, -a2, a3}} also doesn't work. $\endgroup$
    – emnha
    Commented May 7, 2022 at 16:05
5
$\begingroup$

You can first define a 3D matrix (dimensions 6 x 8 x 8) with the appropiate coefficients:

matTotal = {{{1, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0}, {0, 
 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 
 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0}, {0,
  0, 0, 0, 0, 0, 0, 1}}, {{0, 0, 1, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 
 0, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 
 0}, {0, 0, 0, 0, 1, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0,
  0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 1, 0}}, {{-1, 0, -1, 0, 0, 0,
  0, 0}, {0, 1, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0}, {0, 
 0, 0, -1, 0, -1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0}, {0, 0, 0, 1, 0,
  0, 0, 0}, {0, 0, 0, 0, 0, 0, -1, -1}, {0, 0, 0, 0, 0, 0, 1, 
 0}}, {{1, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0}, {-1, 
 0, -1, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 
 0, 0, 0}, {0, 0, 0, -1, 0, -1, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 
 0}, {0, 0, 0, 0, 0, 0, -1, -1}}, {{-1, 0, -1, 0, 0, 0, 0, 0}, {0,
  1, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0, -1, 0,
  -1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 
 0}, {0, 0, 0, 0, 0, 0, -1, -1}, {0, 0, 0, 0, 0, 0, 0, 1}}, {{0, 
 0, 1, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0}, {-1, 0, -1, 0, 0,
  0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 
 0}, {0, 0, 0, -1, 0, -1, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 
 0, 0, 0, 0, -1, -1}}};

And then use standard matrix product with your input vector:

matTotal . {1, 2, 3, 4, 5, 6, 7, 8}

to get the output vectors:

{{1, 2, 3, 4, 5, 6, 7, 8}, {3, 2, 1, 6, 5, 4, 8, 7}, {-4, 2, 1, -10, 
  5, 4, -15, 7}, {1, 2, -4, 4, 5, -10, 7, -15}, {-4, 2, 3, -10, 5, 
  6, -15, 8}, {3, 2, -4, 6, 5, -10, 8, -15}}
$\endgroup$
2
+400
$\begingroup$

My approach is to define a function equivalenceClass that takes a given tuple and maps it to its full equivalence class and then use GatherBy[input,equivalenceClass]. The problem is to construct this function. Also, since equivalenceClass will be called many times, we have to hope that equivalenceClass can be made fast (which also includes that the output is not overly large).

I the following I assume that given a tuple {a1,a2,a3,a4,a5,a6,a7,8} its the full equivalence class is already given by eighttuples. I have not checked that this assumption is true. To standardize this (making it possible for Mathematica to compare equivalence class of different tuples), we generate all tuples and sort afterwards:

eighttuples = {
   {a1, a2, a3, a4, a5, a6, a7, a8},
   {a3, a2, a1, a6, a5, a4, a8, a7},
   {-a1 - a3, a2, a1, -a4 - a6, a5, a4, -a7 - a8, a7},
   {a1, a2, -a1 - a3, a4, a5, -a4 - a6, a7, -a7 - a8},
   {-a1 - a3, a2, a3, -a4 - a6, a5, a6, -a7 - a8, a8},
   {a3, a2, -a1 - a3, a6, a5, -a4 - a6, a8, -a7 - a8}
   };

equivalenceClass = Block[{a},
   Function @@ {a, eighttuples /. {
       a1 -> Indexed[a, 1], a2 -> Indexed[a, 2], a3 -> Indexed[a, 3], 
       a4 -> Indexed[a, 4],
       a5 -> Indexed[a, 5], a6 -> Indexed[a, 6], a7 -> Indexed[a, 7], 
       a8 -> Indexed[a, 8]
       }}
   ];

Now GatherBy should return the correct result. But it is kind of slow:

input = RandomInteger[{-6, 6}, {1000000, 8}];
groupsslow = GroupBy[input, equivalenceClass]; // AbsoluteTiming // First

25.9858

The bottleneck is that the evaluation of equivalenceClass is too slow at the moment. So we use Compile to speed it up.

cEquivalenceClass = Block[{a},
   With[{
     class = eighttuples /. {
        a1 -> Compile`GetElement[a, 1],
        a2 -> Compile`GetElement[a, 2],
        a3 -> Compile`GetElement[a, 3],
        a4 -> Compile`GetElement[a, 4],
        a5 -> Compile`GetElement[a, 5],
        a6 -> Compile`GetElement[a, 6],
        a7 -> Compile`GetElement[a, 7],
        a8 -> Compile`GetElement[a, 8]
        }
     },
    
    Compile[{{a, _Integer, 1}},
     Sort[class],
     CompilationTarget -> "C",
     RuntimeOptions -> "Speed"
     ]
    ]
   ];

Here CompileGetElementis a fancy replacement forIndexthat in conjunction withRuntimeOptions -> "Speed"` suppresses some bound checks in the compiled library, making it slightly faster.

Now we get

groups = GatherBy[input, cEquivalenceClass]; // AbsoluteTiming // First

1.30694

Maybe that makes it already practical for you.

In principle, this can be improved. I don't know what kind of sorting algorithm Mathematica uses for the short list like we have here. Since the length of the list is known and compile time, a sorting network could speed up the Sort quite a lot. Also the problem allows a divide-and-conquer approach to parallelize this: Each processor get just a share of tuples and groups them. That will be the bulk of work. Merging the groups generated by the processors should be fast as long as there are substantially fewer groups than there are elements in input.

It is also possible to run a prefiltering step with a very coarse classifier (or hash) function that cannot differentiate between all equivalence classes but that is cheap to evaluate. In this example, this could be

coarsegroups = GatherBy[input, Sort[Abs[#]] &];

Then it is guaranteed that all elements of a given equivalence class are contained in a single sublist of coarsegroups. The finer classification can then be run on each of these sublists in parallel. Whether this is faster probably depends on how long the outputs of cEquivalenceClass are and on the precise algorithm that Mathematica uses for GatherBy. If it uses direct comparisons of outputs of cEquivalenceClass, then this prefilterung might help. But if uses some hashing technique with a really good hashing function for integer matices (which I expect), then this prefiltering probably won't help much. (It did not in the current example.)

$\endgroup$
2
  • $\begingroup$ Thank you for the nice solution. I'll read it in detail and accept in a few days. $\endgroup$
    – emnha
    Commented Mar 7 at 2:37
  • $\begingroup$ Thank you! I am glad that I could help. $\endgroup$ Commented Mar 7 at 17:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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