Test if a list is a constant integer multiple of another list

Question

I have a list of lists, and I want to eliminate all the lists that are constant integer multiples of another list. My initial approach was to divide the lists using nested tables.

ex1 = {{1, 1, 1}, {1, 1, 2}, {2, 2, 2}, {2, 2, 4}, {3, 3, 5}};
Table[Table[
    If[Subtract @@ MinMax[ex1[[j]]/ex1[[i]]] == 0, 
    ex1[[j]] = ex1[[i]]], {j, i + 1, Length[ex1]}], {i, Length[ex1]}];
Union[ex1]
{{1, 1, 1}, {1, 1, 2}, {3, 3, 5}}

However, some of my lists have zeroes, which breaks my code.

ex2 = {{1, 1, 0}, {1, 1, 2}, {2, 2, 0}, {2, 2, 4}, {3, 3, 5}};
Table[Table[
    If[Subtract @@ MinMax[ex2[[j]]/ex2[[i]]] == 0, 
    ex2[[j]] = ex2[[i]]], {j, i + 1, Length[ex2]}], {i, Length[ex2]}];
Union[ex2]
"CHAOS ENSUES"

I have an alternative approach which is stupid and ugly.

ex3 = {{1, 1, 0}, {1, 1, 2}, {2, 2, 0}, {2, 2, 4}, {3, 3, 5}};
Table[
    Table[
        Table[
            If[ex3[[i]]*k == ex3[[j]], ex3[[j]] = ex3[[i]]], {k, j}], 
    {j, i + 1, Length[ex3]}], 
{i, Length[ex3]}];
Union[ex3]
{{1, 1, 0}, {1, 1, 2}, {3, 3, 5}}

I'm certain there's a better way, but I can't come up with it. I was frustrated by the ugliness of with my first attempt, but at least it was somewhat clever. Can you suggest something nicer?

J. M.'s missing motivation · Answer 1 · 2017-10-14T02:10:58.697

Same principle as kglr's, but using a much cheaper test:

DeleteDuplicates[{{1, 1, 1}, {1, 1, 2}, {2, 2, 2}, {2, 2, 4}, {3, 3, 5}},
                 Norm[Cross[##]] == 0 &]
   {{1, 1, 1}, {1, 1, 2}, {3, 3, 5}}

For eliminating only integer multiples:

DeleteDuplicates[{{2, 2, 2}, {2, 2, 4}, {3, 3, 5}, {3, 3, 6}, {5, 5, 5}, {8, 8, 8}}, 
                 Norm[Cross[##]] == 0 &&
                 (And @@ Thread[Divisible[##] || Divisible[#2, #1]]) &]
   {{2, 2, 2}, {2, 2, 4}, {3, 3, 5}, {3, 3, 6}, {5, 5, 5}}

kglr · Answer 2 · 2017-10-17T09:12:55.607

Update:

I want to eliminate all the lists that are constant integer multiples of another list.

As noted by Simon in a comment all the methods in my original answer eliminate rows that are rational multiples of another row.

To eliminate a row when it is an integer multiple of another row, we can use

ClearAll[f]
f = DeleteDuplicates[#, Reduce[# == k #2 || m # == #2, {k, m}, Integers] =!= False &]

or

f = DeleteDuplicates[#, Resolve[Exists[{k, m}, # == k #2 || m # == #2], Integers] &] &

Examples:

f @ ex1

{{1, 1, 1}, {1, 1, 2}, {3, 3, 5}}

ex2 = {{1, 1, 2}, {2, 2, 2}, {2, 2, 4}, {3, 3, 5}, {5, 5, 5}};
f @ ex2

{{1, 1, 2}, {2, 2, 2}, {3, 3, 5}, {5, 5, 5}}

which is the correct result. The other methods posted so far all eliminate {5, 5, 5} in ex2 because it is a rational multiple of {2, 2, 2}:

DeleteDuplicates[ex2, MatrixRank@{##} == 1 &]

{{1, 1, 2}, {2, 2, 2}, {3, 3, 5}}

jm @ ex2 == gb @ ex2 == DeleteDuplicates[ex2, MatrixRank@{##} == 1 &]

True

Original answer:

DeleteDuplicates[ex1, MatrixRank @ {##} == 1 &]
DeleteDuplicates[ex1, Length @ SingularValueList @ {##} == 1 &]
DeleteDuplicates[ex1, RowReduce[{##}][[2]] == {0, 0, 0} &]

{{1, 1, 1}, {1, 1, 2}, {3, 3, 5}}

+1 because it's clever but doesn't this eliminate rows which are rational multiples of another row, not just integer multiples? — Simon Woods, Oct 13 '17 at 20:26
@Simon, updated with a clunkier but, I think, correct method. — kglr, Oct 13 '17 at 22:44

Mr.Wizard · Accepted Answer · 2017-10-13T23:46:30.850

9

GatherBy is much faster than the pairwise-compare of DeleteDuplicates with a custom comparator.

jm = DeleteDuplicates[#, Norm[Cross[##]] == 0 &] &;

gb = GatherBy[#, #/Max[1, GCD @@ #] &][[All, 1]] &;

Needs["GeneralUtilities`"]

BenchmarkPlot[{jm, gb}, RandomInteger[9, {#, 3}] &, 5, "IncludeFits" -> True]

Other examples:

Checking for duplicates in sublists

edited Oct 13 '17 at 23:46

answered Oct 13 '17 at 23:39

Mr.Wizard

271,378
34
587
1,371

If involves negative multiples, may not get the correct result. GatherBy[{{1,2,3},{2,4,6},{-2,-4,-6},{1,2,-3},{1,-2,3}},#/Max[1,GCD@@#]&] – expression Nov 11 '20 at 16:59
@expression Caveat noted. Thank you. – Mr.Wizard Dec 03 '20 at 20:47

score 1 · Answer 4 · answered Nov 10 '17 at 00:19

1

Just divide one list by the ratio of the first elements of each list. Then check if they’re equal

answered Nov 10 '17 at 00:19

Paul

111
2

1

should work, but mind the zeros... maybe add some code? – M. Stern Nov 10 '17 at 02:00
Good point. This is an easy case to test— simply test if the first element of either list is zero. – Paul Nov 10 '17 at 02:02

score 0 · Answer 5 · answered Nov 10 '17 at 06:57

0

SeedRandom[1]
mat = RandomInteger[{1, 100}, {10^5, 3}];

r1 = GatherBy[mat, #/Max[1, GCD @@ #] &][[All, 1]]; // AbsoluteTiming

r2 = GatherBy[mat, #/Tr@# &][[All, 1]]; // AbsoluteTiming

r1 == r2

{0.548749, Null}

{0.505526, Null}

True

answered Nov 10 '17 at 06:57

matrix42

6,996
2
26
62

Wouldn't that code break if you include 0's in your matrix? – Lokdal Nov 10 '17 at 13:53

Test if a list is a constant integer multiple of another list

5 Answers5

Linked