10
$\begingroup$

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?

$\endgroup$
9
$\begingroup$

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]

enter image description here

Other examples:

$\endgroup$
11
$\begingroup$

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}}
$\endgroup$
9
$\begingroup$

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}}

$\endgroup$
  • 1
    $\begingroup$ +1 because it's clever but doesn't this eliminate rows which are rational multiples of another row, not just integer multiples? $\endgroup$ – Simon Woods Oct 13 '17 at 20:26
  • $\begingroup$ @Simon, right... oops. Thank you for the vote. $\endgroup$ – kglr Oct 13 '17 at 20:39
  • $\begingroup$ @Simon, updated with a clunkier but, I think, correct method. $\endgroup$ – kglr Oct 13 '17 at 22:44
1
$\begingroup$

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

$\endgroup$
  • 1
    $\begingroup$ should work, but mind the zeros... maybe add some code? $\endgroup$ – M. Stern Nov 10 '17 at 2:00
  • $\begingroup$ Good point. This is an easy case to test— simply test if the first element of either list is zero. $\endgroup$ – Paul Nov 10 '17 at 2:02
0
$\begingroup$
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

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

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.