3
$\begingroup$

I have a list of lists like this one, where the sublists vary in length.

list = {{0, 1, 2}, {0, -2, 4}, {0, 3, 6}, {1, 2, 3}, {0, 0}, {2, 4, 6}, {-2, -4, -6}, {1, 2, -3}, {1, -2, 3}, {-6, -8, -10}, {0.3, 0.4, 0.5}, {0, 0}};

I want to rearrange the list so that each group has all the multiples of the sublists grouped together. The above example should give this reorganized list:

{{0, 1, 2}, {0, 3, 6}}
{{0, -2, 4}}
{{1, 2, 3}, {2, 4, 6}, {-2, -4, -6}}
{{0, 0}, {0, 0}}
{{1, 2, -3}}
{{1, -2, 3}}
{{-6, -8, -10}, {0.3, 0.4, 0.5}}

I have read this post, but it’s mainly suitable for positive integer multiples and equal-length sublists. This method fails with my example.

GatherBy[list, #/Max[1, GCD @@ #] &]

I prefer the solution based on GatherBy instead of Gather, because GatherBy is much more efficient.

$\endgroup$
5
$\begingroup$

Updated

list = {{0, 1, 2}, {0, -2, 4}, {0, 3, 6}, {1, 2, 3}, {0, 0}, {2, 4, 
    6}, {-2, -4, -6}, {1, 2, -3}, {1, -2, 3}, {-6, -8, -10}, {0.3, 
    0.4, 0.5}, {0, 0}};
f[w_] := Sort@{Normalize[Rationalize@w], -Normalize[Rationalize@w]}
GatherBy[list, f]

{{{0, 1, 2}, {0, 3, 6}}, {{0, -2, 4}}, {{1, 2, 3}, {2, 4, 6}, {-2, -4, -6}}, {{0, 0}, {0, 0}}, {{1, 2, -3}}, {{1, -2, 3}}, {{-6, -8, -10}, {0.3, 0.4, 0.5}}}

The trick is, for a vector $(x,y,z)$, we map it into two vectors $\{ (x,y,z),-(x,y,z) \}$, and Sort the two vectors in this set.

So the two vectors $(a,b,c)$ and $(-a,-b,-c)$ are map into the same order set $$\{(a,b,c),(-a,-b,-c)\}$$

so they regard as the same object!

For example,

u = {1, -2, 3};
v = {-1, 2, -3};
Sort[{u, -u}] === Sort[{v, -v}]
(* True *)

Original

Not so effect. Here we define a normalize function.

Function[w, (Sign@First@w)*Normalize[Rationalize@w, Sqrt[#.#] &]]

for example, if w={x,y,z},we first Rationalize w,and then calculate $$ \frac{x}{\sqrt{x^2+y^2+z^2}},\frac{y}{\sqrt{x^2+y^2+z^2}},\frac{z}{\sqrt{x^2+y^2+z^2}}$$

after this,we make the $\frac{x}{\sqrt{x^2+y^2+z^2}}$ is positive by multiple the vector the sign of x.

list = {{1, 2, 3}, {0, 0}, {2, 4, 6}, {-2, -4, -6}, {1, 
    2, -3}, {1, -2, 3}, {-6, -8, -10}, {0.3, 0.4, 0.5}, {0, 0}};
GatherBy[list, 
 Function[w, (Sign@First@w)*Normalize[Rationalize@w, Sqrt[#.#] &]]]

{{{1, 2, 3}, {2, 4, 6}, {-2, -4, -6}}, {{0, 0}, {0, 0}}, {{1, 2, -3}}, {{1, -2, 3}}, {{-6, -8, -10}, {0.3, 0.4, 0.5}}}

Other idea

Maybe MatrixRank is another way.

$\endgroup$
3
  • 1
    $\begingroup$ Thank you. See my updated,{{0, 1, 2}, {0, -2, 4}} should not be grouped together. $\endgroup$ – expression Nov 12 '20 at 9:05
  • $\begingroup$ list = {{0, 1, 2}, {0, -2, 4}, {0, 3, 6}, {1, 2, 3}, {0, 0}, {2, 4, 6}, {-2, -4, -6}, {1, 2, -3}, {1, -2, 3}, {-6, -8, -10}, {0.3, 0.4, 0.5}, {0, 0}}; Region[#, BaseStyle -> Blue] & /@ (AffineSpace @@ {{#, -#}} & /@ list) $\endgroup$ – cvgmt Nov 12 '20 at 12:32
  • $\begingroup$ GatherBy[list, Round[Sort@{-#, #} &@{Normalize[#, Norm[#, 1] &]}, .0001] &] modified by chy. $\endgroup$ – cvgmt Nov 14 '20 at 6:52
2
$\begingroup$
ClearAll[proj]
proj = KroneckerProduct[#, #] &[Normalize @ Rationalize @ #] &;

GatherBy[list, proj] // Column

enter image description here

ClearAll[fit]
fit = Fit[{Table[0, Length@#], #}, Array[x, Length[#]-1], Array[x, Length[#]-1]]&;

GatherBy[list, fit] // Column

enter image description here

$\endgroup$
3
  • $\begingroup$ There seems to be something wrong, consider this example, GatherBy[{{-11, -11, 22}, {2, -1, -1}, {-6, 10, -4}}, Projection[Table[1, Length@#], #] &] $\endgroup$ – expression Nov 13 '20 at 2:43
  • $\begingroup$ @expression, updated with something that (I hope) works in general. $\endgroup$ – kglr Nov 13 '20 at 2:49
  • $\begingroup$ Thank you.This should be fine. $\endgroup$ – expression Nov 13 '20 at 3:00
1
$\begingroup$

If we does not insist on using GatherBy ,then there other way can be use to get the same result by using Gather.

Gather is easy to handle.

Method I

list = {{0, 1, 2}, {0, -2, 4}, {0, 3, 6}, {1, 2, 3}, {0, 0}, {2, 4, 
    6}, {-2, -4, -6}, {1, 2, -3}, {1, -2, 3}, {-6, -8, -10}, {0.3, 
    0.4, 0.5}, {0, 0}, {Sqrt[3], Sqrt[3]}, {1, 1}, {0, 0, 0}, {1, 1, 
    1}, {2., 2., 2.}, {π Sqrt[3], 2 π Sqrt[3], 
    3 π Sqrt[3]}};
Gather[list, 
 RegionEqual[AffineSpace[{#1, -#1}], AffineSpace[{#2, -#2}]] &]

Method II

list = {{0, 1, 2}, {0, -2, 4}, {0, 3, 6}, {1, 2, 3}, {0, 0}, {2, 4, 
    6}, {-2, -4, -6}, {1, 2, -3}, {1, -2, 3}, {-6, -8, -10}, {0.3, 
    0.4, 0.5}, {0, 0}, {Sqrt[3], Sqrt[3]}, {1, 1}, {0, 0, 0}, {1, 1, 
    1}, {2., 2., 2.}, {π Sqrt[3], 2 π Sqrt[3], 
    3 π Sqrt[3]}};
Gather[list, 
 Length[#1] == Length[#2] && Norm[#1] == Norm[#2] == 0 || 
   Length[#1] == Length[#2] && Norm[#1]*Norm[#2] != 0 && 
    MatrixRank[{#1, #2}] == 1 &]

{{{0, 1, 2}, {0, 3, 6}}, {{0, -2, 4}}, {{1, 2, 3}, {2, 4, 6}, {-2, -4, -6}, {Sqrt[3] π, 2 Sqrt[3] π, 3 Sqrt[3] π}}, {{0, 0}, {0, 0}}, {{1, 2, -3}}, {{1, -2, 3}}, {{-6, -8, -10}, {0.3, 0.4, 0.5}}, {{Sqrt[3], Sqrt[3]}, {1, 1}}, {{0, 0, 0}}, {{1, 1, 1}, {2., 2., 2.}}}

$\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.