# Find duplicates in list of InfiniteLine

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.

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

• It was not obvious to me that I was preventing the optimal way. I edited the question and lifted the constraint. May 1 '16 at 17:00
• @anderstood I added such a version now. Arithmetic operators are cheap, trigonometric functions are not as cheap, and who knows what the higher order region functionality use. If you want something fast you shouldn't be excluding simple arithmetic, it just forces people to use more computationally expensive stuff. May 1 '16 at 19:05
• Thanks. I did not ask explicitly for a solution without arithmetic operators, but for something which did not consist, if possible, in reprogramming everything from scratch. Using DeleteDuplicates is perfectly fine. Your code is much faster, however it does not make the distinction between parallel but distinct lines, such as lines defined by $(0,0),(0,1)$ and $(1,0),(1,1)$. It probably suffices to add a distance test (if parallel and distance is 0, then it's the same line). I'll make a suggestion when I can. May 2 '16 at 0:54
• @anderstood You are right, I added something I think works. May 2 '16 at 1:59
• Dot[u1 - u2, {-1, 1} Reverse[v1 - v2]] can be simplified to Dot[u1 - u2, Cross[v1 - v2]] or Det[{u1 - u2, v2 - v1}]. Sep 18 '20 at 15:38
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}}]}

• The VectorAngle solution does not work for lines = {InfiniteLine[{{0, 1}, {1, 1}}], InfiniteLine[{{1, 1}, {2, 1}}]}; Mar 5 at 8:50
• Thank you @SjoerdSmit. Removed that part.
– kglr
Mar 5 at 18:22

Here's another approach:

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

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

• I don't know why, but i) this solution is about two times slower than kglr's, and ii) I sometimes end up with 1 duplicate for each element of a list. I'll investigate why. Point ii) could be due to numerical tolerance. Apr 30 '16 at 21:22
• @anderstood. Yeah it's probably due to numerical tolerance. I'll also look into it some more later tonight. Apr 30 '16 at 21:58

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

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

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.