# How to delete duplicate graphics of the same kind?

A054247: Number of n X n binary matrices under action of dihedral group of the square D_4.

(*半念浮生*)
g[list_] := {list, Reverse /@ list, Reverse@list,
Reverse /@ Reverse@list};
g1[list_] := (g[list]~Join~g[Transpose@list]) // Sort;
(tmp = GatherBy[Partition[#, 3] & /@ Tuples[{0, 1}, 9],
g1]) // Length(* 3*3 *)
Map[MatrixPlot[#, Frame -> None, FrameTicks -> None, Mesh -> All,
ColorFunction -> "Monochrome",
ImageSize -> Scaled[.04]] &, tmp, {2}]
% // Flatten // Length


I wonder if there is a more general way to solve this problem? For example, use the knowledge of group theory to solve it. Bibliography: 应用组合学 P298 • Which ones are duplicates? Feb 26, 2021 at 4:15
• @MassDefect That is to say, the figures that can be overlapped after rotating and flipping are repeated. I want to use a more general and effective method to remove duplication. Feb 26, 2021 at 4:28
• You haven't really stated the problem. According to your comment, couldn't you just take one random element from each of the sublists in your output? Feb 26, 2021 at 5:16
• ..or using g, DeleteDuplicatesBy[Union[g@#, g@Transpose@#] &]@ Tuples[{0, 1}, {n, n}] // Length?
– kglr
Feb 26, 2021 at 7:48
• Instead of working with squares, work with actual binary matrices instead. Mar 1, 2021 at 8:48

Here is a suggestion from group theory:

We need to define an action on squares for the eight elements of DihedralGroup. In general, it would be enough to define it for the two generators and then construct the rest using the GroupElementToWord/FromWord functionality, but I think it is instructive to define the whole action here, because this group is small. It is possible to use any representation you want for the squares, and I'll use matrices. The action function must be defined for the representation chosen, so I'll construct everything using Transpose and Reverse:

action[matrix_, Cycles[{}]] := matrix;
action[matrix_, Cycles[{{2, 4}}]] := Transpose[matrix];
action[matrix_, Cycles[{{1, 2}, {3, 4}}]] := Reverse[matrix, {2}];
action[matrix_, Cycles[{{1, 2, 3, 4}}]] := Transpose[Reverse[matrix]];
action[matrix_, Cycles[{{1, 3}}]] := Reverse[Transpose[Reverse[matrix]]];
action[matrix_, Cycles[{{1, 3}, {2, 4}}]] := Reverse[matrix, {1, 2}];
action[matrix_, Cycles[{{1, 4, 3, 2}}]] := Reverse[Transpose[matrix]];
action[matrix_, Cycles[{{1, 4}, {2, 3}}]] := Reverse[matrix];


You can imagine that the numbers 1, 2, 3, 4 in the permutations refer to square corners, numbered clockwise, say.

Then this gives the list of all matrices of dimensions {n, n} containing zeros and/or ones:

all01s[n_] := Tuples[{0, 1}, {n, n}]


Finally the computation you want is a simple call to GroupOrbits:

GroupOrbits[DihedralGroup, all01s, action] // Length
(* 6 *)

GroupOrbits[DihedralGroup, all01s, action] // Length
(* 102 *)

GroupOrbits[DihedralGroup, all01s, action] // Length
(* 8548 *)

• Thank you very much for the answer. It's very useful. Mar 2, 2021 at 1:38

Re-writing OP's g1 using transformations from jose's answer:

ClearAll[transformations, deleteDupes]

transformations = Union[{#, Reverse @ #, Reverse[#, {2}], Reverse[#, {1, 2}],
Transpose @ #, Reverse @ Transpose @ #,
Transpose @ Reverse @ #, Reverse @ Transpose @ Reverse @ #}] &;

deleteDupes = DeleteDuplicatesBy[transformations][Tuples[{0, 1}, {#, #}]] &;

Length /@ deleteDupes /@ {2, 3, 4}

{6, 102, 8548}


Recreating images:

m = Table[RandomInteger[], 100, 3, 3]; i = Image[m[[#]]] & /@ Range[Length[m]] You can just use DeleteDuplicates[] here which is pretty nice, and ImageRotate[], although I think the original question was not with created images.

Make images into MorphologicalComponents[]. You can get the position of all repeating images by:

images = MorphologicalComponents[#] & /@ i;
GatherBy[Range@Length[images], images[[#]] &]

out: {{1,46},{2},{3},{4},{5,33,53},{6},{7},{8},{9},{10},{11},{12},{13},{14},{15},{16,97},{17},{18},{19},{20},{21},{22},{23},{24},{25},{26,62},{27},{28},{29},{30},{31},{32,69},{34},{35},{36},{37},{38},{39},{40},{41},{42},{43},{44,48},{45},{47},{49,81},{50},{51},{52},{54},{55},{56,78},{57,72},{58},{59,82},{60},{61},{63},{64},{65},{66},{67},{68},{70},{71},{73},{74},{75},{76},{77},{79},{80},{83},{84},{85},{86},{87},{88},{89},{90},{91},{92},{93},{94},{95},{96},{98},{99},{100}}


Again use ImageRotate[] to get all combinations, or maybe Tuples[]?

Or if you would like a more True or False method, maybe:

images = MorphologicalComponents[#] & /@ i;