Find duplicates in list of InfiniteLine

Question

MMA 10 introduced a new function, which can be very convenient: InfiniteLine.

Of course, two infinite lines can be described by different arguments: for example InfiniteLine[{{0,0},{1,0}}] and InfiniteLine[{{0,0},{2,0}}] are identical. How can I delete duplicates in a list of infinite line?

For example,

lines = {InfiniteLine[{{0,0},{1,0}}], InfiniteLine[{{0,0},{2,0}}],
         InfiniteLine[{{0,1},{1,0}}]};
myDeleteDuplicates[lines]

should return

{InfiniteLine[{{0,0},{1,0}}], InfiniteLine[{{0,1},{1,0}}]}

Edit In my original question, I had written

I would like to avoid if possible comparing lines "by hand", i.e. by
  translating and normalising the arguments of InfiniteLine.

I had not expected this constraint to result in a (possible) significant increase of computation time. Let's lift it, hoping it will not penalise the existing answerers too much.

C. E. · Accepted Answer

It still feels a little bit wasteful for me to use a trigonometric function so there's room for improvement, but it's not as wasteful as bringing to bear region functionality on this problem:

sameLine[InfiniteLine[{u1_, u2_}], InfiniteLine[{v1_, v2_}]] := With[{u = u1 - u2, v = v1 - v2},
  PossibleZeroQ[VectorAngle[u, v]] || PossibleZeroQ[VectorAngle[u, v] - Pi]
  ]

DeleteDuplicates[lines, sameLine]

{InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]}

Here is a version with just the square root and multiplication:

sameLine[InfiniteLine[{u1_, u2_}], InfiniteLine[{v1_, v2_}]] := With[{u = u1 - u2, v = v1 - v2},
  PossibleZeroQ[Abs[Dot[u1 - u2, v1 - v2]/(Norm[u1 - u2] Norm[v1 - v2])] - 1]
  ]

or another even simpler form:

sameLine[InfiniteLine[{u1_, u2_}], InfiniteLine[{v1_, v2_}]] := 
 PossibleZeroQ[Dot[u1 - u2, {-1, 1} Reverse[v1 - v2]]]

All of the previous functions have the flaw that they don't count parallel lines as duplicates. We can fix that by adding another condition:

sameLine[InfiniteLine[{u1_, u2_}], InfiniteLine[{v1_, v2_}]] := And[
  PossibleZeroQ[Dot[u1 - u2, {-1, 1} Reverse[v1 - v2]]],
  PossibleZeroQ[Dot[u1 - v1, {-1, 1} Reverse[v1 - v2]]]
  ]

kglr · Answer

DeleteDuplicates[lines, RegionWithin]

{InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]}

Also
DeleteDuplicates[lines, MemberQ[{##}, RegionIntersection @ ##]&]

{InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]}

RunnyKine · Answer

Here's another approach:

DeleteDuplicates[lines, And @@ RegionMember[#, #2[[1]]] &]

(* {InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]} *)

matrix89 · Answer

After version 11.1

lines={ InfiniteLine[{{0,0},{1,0}}], InfiniteLine[{{0,0},{2,0}}],
        InfiniteLine[{{0,1},{1,0}}], InfiniteLine[{{0,1},{4,-3}}] };

DeleteDuplicates[lines, RegionEqual]

{InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]}

kirma · Answer

RegionEqual, like many region functions, is able to compute symbolic results as long as arguments are fully specified. This allows more efficient constructions of the following kind - where the symbolic solution is found and simplified before the testing function is defined:
ClearAll@equalLineQ;

equalLineQ[InfiniteLine[{{a_, b_}, {c_, d_}}], 
  InfiniteLine[{{e_, f_}, {g_, h_}}]] := 
 Evaluate@FullSimplify@
   RegionEqual[InfiniteLine[{{a, b}, {c, d}}], 
    InfiniteLine[{{e, f}, {g, h}}]]

->
? equalLineQ

equalLineQ[InfiniteLine[{{a_, b_}, {c_, d_}}], InfiniteLine[{{e_, f_}, {g_, h_}}]] := b c + d e + a f == a d + b e + c f && b c + d g + a h == a d + b g + c h

And thus:
DeleteDuplicates[{InfiniteLine[{{0, 0}, {1, 0}}], 
  InfiniteLine[{{0, 0}, {2, 0}}], 
  InfiniteLine[{{0, 1}, {1, 0}}]}, equalLineQ]

{InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]}

Technically this kind of constructs could be entirely automated, but it's surprisingly convoluted, and would clutter this answer to a considerable extent.

chyanog · Answer

For a large set of lines, this will be faster
Clear["`*"];
eps=10^-9.;

sameLine1[InfiniteLine@{{x1_,y1_},{x2_,y2_}}]:=
  Sort@Round[{-#,#},eps]&@Normalize[{y1-y2, x2-x1,x1 y2-x2 y1}];

sameLine2[InfiniteLine@{a_,b_},InfiniteLine@{c_,d_}]:=
  Abs@Det[{a-b,d-c}]<eps&&Abs@Det[{a-c,d-c}]<eps;

Length[lines=InfiniteLine /@ RandomSample@Join[RandomReal[1,{400,2,2}],
  Join@@Table[RandomPoint[Line@RandomReal[1,{2,2}],{2,2}],300]]]

Length[r1=DeleteDuplicatesBy[lines,sameLine1]]//AbsoluteTiming
Length[r2=DeleteDuplicates[lines,sameLine2]]//AbsoluteTiming

r1===r2

Output:

1000
{0.0135183, 700}
{2.40766, 700}
True

Find duplicates in list of InfiniteLine

6 Answers

Add your own answers!

Ask a Question