Grouping the list

Question

Let's assume that I have randomly generated list

 llist = {{0, 1}, {2, 1}, {4, 4}, {0, 3}, {3, 4}, {2, 2}, {2, 3}, {2, 0}};

We can represent this data using the following plot,

I want to group the elements, but I can only group them by same x elements or y elements.

For example, if I group them with the same x elements, I got five groups,

{{{4,4},{3,4}},{{0,3},{2,3}},{{2,2}},{{0,1},{2,1}},{{2,0}}}

If I group them with the same y elements, I got four groups

{{{0, 1},{0, 3}},{{2, 1},{2, 2},{2, 3},{2, 0}},{{3, 4}},{{4, 4}}}

However, if I group them with x and y simultaneously, I can reduce the group by three.

I am looking for an efficient way to group them. I attach my naive coding method.

---

(*Where I want to save group*)
group1 = {};
(*Count them*)
countx = Table[{i, Count[llist[[All, 1]], i]}, {i, 0, 4}];
county = Table[{i, Count[llist[[All, 2]], i]}, {i, 0, 4}];
(*Find the bigger grouping*)
mcx = Select[countx, #[[2]] == Max[countx[[All, 2]]] &][[1]];
mcy = Select[county, #[[2]] == Max[county[[All, 2]]] &][[1]];
(*if x grouping is more,than group them by x and remove their group \
from the list,if y grouping is more or equal,group them by y and remove from \
the list, and call that list as llist1*)
If[mcx[[2]] > 
   mcy[[2]], {group1 = 
    Append[group1, 
     llist[[Flatten[Position[llist[[All, 1]], mcx[[1]]]]]]], 
   llist1 = 
    Delete[llist, Position[llist[[All, 1]], mcx[[1]]]]}, {group1 = 
    Append[group1, 
     llist[[Flatten[Position[llist[[All, 2]], mcy[[1]]]]]]], 
   llist1 = Delete[llist, Position[llist[[All, 2]], mcy[[1]]]]}];

group1 will have the first largest elements, {{{2, 1}, {2, 2}, {2, 3}, {2, 0}}}, and the new list llist1 will now have {{0, 1}, {4, 4}, {0, 3}, {3, 4}}.

If I try again,

(*Repeat*)
countx1 = Table[{i, Count[llist1[[All, 1]], i]}, {i, 0, 4}];
county1 = Table[{i, Count[llist1[[All, 2]], i]}, {i, 0, 4}];
mcx1 = Select[countx1, #[[2]] == Max[countx1[[All, 2]]] &][[1]];
mcy1 = Select[county1, #[[2]] == Max[county1[[All, 2]]] &][[1]];
If[mcx1[[2]] > 
   mcy1[[2]], {group1 = 
    Append[group1, 
     llist1[[Flatten[Position[llist1[[All, 1]], mcx1[[1]]]]]]], 
   llist2 = 
    Delete[llist1, Position[llist1[[All, 1]], mcx1[[1]]]]}, {group1 = 
    Append[group1, llist1[[Flatten[Position[llist1[[All, 2]], mcy1[[1]]]]]]], 
llist2 = Delete[llist1, Position[llist1[[All, 2]], mcy1[[1]]]]}];

I can find my second biggest group, {{4, 4}, {3, 4}}, and my last list will be {{0, 1}, {0, 3}}

(*Repeat*)
countx2 = Table[{i, Count[llist2[[All, 1]], i]}, {i, 0, 4}];
county2 = Table[{i, Count[llist2[[All, 2]], i]}, {i, 0, 4}];
mcx2 = Select[countx2, #[[2]] == Max[countx2[[All, 2]]] &][[1]];
mcy2 = Select[county2, #[[2]] == Max[county2[[All, 2]]] &][[1]];
If[mcx2[[2]] > 
   mcy2[[2]], {group1 = 
    Append[group1, 
     llist2[[Flatten[Position[llist2[[All, 1]], mcx2[[1]]]]]]], 
   llist3 = 
    Delete[llist2, Position[llist2[[All, 1]], mcx2[[1]]]]}, {group1 = 
    Append[group1, 
     llist2[[Flatten[Position[llist2[[All, 2]], mcy2[[1]]]]]]], 
   llist3 = Delete[llist2, Position[llist2[[All, 2]], mcy2[[1]]]]}];

My last repeat will group the last elements, so you will get

group1
(*{{{2, 1}, {2, 2}, {2, 3}, {2, 0}}, {{4, 4}, {3, 4}}, {{4, 4}, {3, 4}}, {{0, 1}, {0, 3}}}*)

and llist3 will be empty, so we can stop the algorithm.

Answer 1

We can use GatherBy (or GroupBy) to group by the first or second column:

GatherBy[llist, First] // Column

GatherBy[llist, Last] // Column

To get the last grouping in OP, define two functions take and drop and use them with NestWhileList:

ClearAll[take, drop]
take[lst_] := First @ MaximalBy[Length][Join @@ (GatherBy[lst, #] & /@ {First, Last})]; 
drop[lst_] := DeleteCases[Alternatives @@ take @ lst] @ lst

take /@ Most@NestWhileList[drop, llist, # =!= {} &] // Column

Alternatively, use Reap/Sow with take:

ClearAll[take2]
take2 = Reap[NestWhileList[
  DeleteCases[Alternatives @@ Sow[take @ #]] @ # &, #, # =!= {} &]][[2, 1]] &;

take2 @ llist // Column

Pictures

ClearAll[matrixPlot]

matrixPlot = Module[{groups = #}, 
    MatrixPlot[Reverse @ SparseArray @ Flatten @ 
     MapIndexed[Thread[1 + Reverse /@ # -> #2[[1]]] &, groups], 
     DataRange -> {{0, 4}, {0, 4}}, 
     Mesh -> All, 
     ColorRules -> Map[# -> ColorData[97]@# &, Range[Length @ groups]], 
     ImageSize -> 1 -> 70, 
     PlotLegends -> SwatchLegend[ColorData[97] /@ Range[Length@groups], 
       InputForm /@ groups, 
       LegendFunction -> (Column[{Style["  groups:", 16], #}] &)]]] &;


Column[matrixPlot /@ {GatherBy[llist, First], GatherBy[llist, Last], take2 @ llist}]