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$

3 Answers 3

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, 2020 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, 2020 at 12:32
  • $\begingroup$ GatherBy[list, Round[Sort@{-#, #} &@{Normalize[#, Norm[#, 1] &]}, .0001] &] modified by chy. $\endgroup$
    – cvgmt
    Nov 14, 2020 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, 2020 at 2:43
  • $\begingroup$ @expression, updated with something that (I hope) works in general. $\endgroup$
    – kglr
    Nov 13, 2020 at 2:49
  • $\begingroup$ Thank you.This should be fine. $\endgroup$
    – expression
    Nov 13, 2020 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 and acknowledge you have read our privacy policy.

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