2
$\begingroup$

First of all, I work with modular arithmetics and the elements of the arithmetics are lists themselves.

I recognize two kinds of symmetries - shift and mirroring. We could define shift of a list like this:

mod = {3, 2};
shiftBy[set_, shift_] := Mod[shift + #, mod] & /@ set

I consider two sets to be equivalent if one can be obtained from the other by shifting.

The other symmetry is sign swapping at one or more positions, like swap sign on first member of each element. We could define it like this (return all elements with sign flipped on one of the elements members):

mod = {3, 2};
swapSignAt[set_, position_] := Table[
      element[[position]] = Mod[-element[[position]], mod][[position]]; 
      element, 
      {element, set}]

Example

Let's define some sets:

set1 = {{1, 0}, {1, 0}, {2, 1}};
set2 = {{0, 1}, {0, 1}, {1, 0}};
set3 = {{2, 0}, {2, 0}, {1, 1}};
set4 = {{2, 1}, {2, 1}, {1, 0}};
set5 = {{1, 0}, {2, 0}, {2, 1}};
listOfSets = {set1,set2,set3,set4,set5}

In this case set1, set2, set3, set4 are considered to be equivalent because set2 = shiftBy[set1, {2, 1}], set3 = swapSignAt[set1, 1], set4 = swapSignAt[shiftBy[set1, {0, 1}], 1].

I need such a function that would remove me the equivalent elements:

removeEquivalent[listOfLists]

It should return {set1,set5} (of course the content not the names like set1) or some other set of 2 non-equivalent sets.

How do I construct such a function? I suppose I should create an equivalence test setsEquivQ and use DeleteDuplicates[listOfSets, setsEquivQ], but the symmetries are so complicated I have trouble constructing such test.

Some notes. The value of mod can be list of variable length, in the real code mod is passed to functions. For example the elements could be triples and mod could be {8,9,7}. I also have possibleShifts[mod] available - it seems that such list might be handy when testing the shifting equivalence.

Edit: The element order doesn't matter. We could append //Sort to those symmetry functions to make the sets more standartised.

Edit 2: For the context. What matters for me in the end is Differences @* DeleteDuplicates @ Tuples[set, 2] - differences of all pairs. This result isn't affected by sorting set or shifting the elements. And swapping a sign in a component would only swap a sign in result but does not affect the compositions of the result (if 2 of the differences are the same or not same, it will stay that way when sign of one component is flipped on each). However, I am not directly checking the result as some non-equivalent sets can give the same result. Example.

$\endgroup$
  • $\begingroup$ Could you define a canonical form such that set1 and set2 would be equivalent iff canonical[set1]==canonical[set2]? $\endgroup$ – anderstood Apr 6 '17 at 18:05
  • $\begingroup$ Typo fixed, thanks. Nice idea @anderstood, I will have to think about it. But I couldn't come up with a solution within the first 5 minutes :) $\endgroup$ – Džuris Apr 6 '17 at 18:17
  • $\begingroup$ @CarlWoll I edited few mins earlier to include that the order of the elements doesn't matter so there is no "first" element and no clear answer what to shift to 0. $\endgroup$ – Džuris Apr 6 '17 at 18:28
  • $\begingroup$ Never mind my canonicalization comment, then. $\endgroup$ – Carl Woll Apr 6 '17 at 18:43
3
$\begingroup$

The idea, I originally learnt from Szabolcs's answer, is to find a canonical form, when possible. Not only is this approach more efficient, I think it is also sounder and helps grasp what is happening.

This is what I suggest in your case to define a canonical form:

  1. shift the set using shiftBy so that its first element is {0,0}
  2. take the first list of the set which is not {0,0} and apply swapSignAt at position $i$ if and only if it decreases the $i$th element.

The following code returns such a canonical form of a set.

can[set_] := Block[{},
  (* find the shift position which starts by {0,0} by brute force *)
  set0 = shiftBy[set, mod - set[[1]]];

  (* takes the first non-zero list *)      
  list0 = Select[set0, # != {0, 0} &, 1];

  (* swap pos 1 if  first element of list0 would be reduced *)      
  If[swapSignAt[list0, 1][[1, 1]] < list0[[1, 1]], set0 = swapSignAt[set0, 1]];

  (* swap pos 2 if  second element of list0 would be reduced *)
  If[swapSignAt[list0, 2][[1, 2]] < list0[[1, 2]], set0 = swapSignAt[set0, 2]];

  set0
  ]

Then simply use use DeleteDuplicatesBy:

DeleteDuplicatesBy[setlist, can]
(* {{{1, 0}, {1, 0}, {2, 1}}, {{1, 0}, {2, 0}, {2, 1}}} *)

which returns set1 and set5, as expected.

Note The above takes into account the order of the set. If you want to relax this constraint, you should sort the elements of the set (I have not tried; maybe it is more complicated than it seems...).

$\endgroup$
  • $\begingroup$ Thanks for your contribution! As the ordering doesn't matter, this is a bit harder as it's unclear which element should be shifted to 0. I might make a can[set_,n_] that would make canonical form with respect to nth element not the first one. Then I can compare can[set1,1]//Sort with each of can[set2,n]//Sort. Let me know if you have an even better idea :) $\endgroup$ – Džuris Apr 7 '17 at 9:41
  • $\begingroup$ @Džuris The order of the lists (e.g. {1,0}) do not matter, but does the order within the list matter (is {1,0} and {0,1} similar?) ? $\endgroup$ – anderstood Apr 7 '17 at 14:35
  • $\begingroup$ @Džuris Does can /@ Sort @ setlist do what you want? $\endgroup$ – anderstood Apr 7 '17 at 14:39
  • $\begingroup$ yes, {1,0} and {0,1} are different elements. You can reorder elements or shift all of the elements in set, but you can't tinker with individual elements. And I am not sure if you wrote what you meant in the last comment... ? But if you'd sort and then canonize the sets, set1 and set4 would end up different, but they are equivalent. $\endgroup$ – Džuris Apr 7 '17 at 17:35
  • $\begingroup$ I am not sure if it is possible to find a canonical form in this case. Is efficiency a concern for you? Otherwise you could always do a brute-force approach... $\endgroup$ – anderstood Apr 7 '17 at 18:30

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.