Test if a list is a constant integer multiple of another list
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}}
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}}
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