19
$\begingroup$

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.

$\endgroup$
10
$\begingroup$

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]]]
  ]
$\endgroup$
  • $\begingroup$ It was not obvious to me that I was preventing the optimal way. I edited the question and lifted the constraint. $\endgroup$ – anderstood May 1 '16 at 17:00
  • 1
    $\begingroup$ @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. $\endgroup$ – C. E. May 1 '16 at 19:05
  • 1
    $\begingroup$ 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. $\endgroup$ – anderstood May 2 '16 at 0:54
  • $\begingroup$ @anderstood You are right, I added something I think works. $\endgroup$ – C. E. May 2 '16 at 1:59
16
$\begingroup$
DeleteDuplicates[lines, MemberQ[{##},RegionIntersection @ ##]&]

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

Also

DeleteDuplicatesBy[VectorAngle @@ #[[1]] &]@lines

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

$\endgroup$
11
$\begingroup$

Here's another approach:

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

(* {InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]} *)
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – anderstood Apr 30 '16 at 21:22
  • $\begingroup$ @anderstood. Yeah it's probably due to numerical tolerance. I'll also look into it some more later tonight. $\endgroup$ – RunnyKine Apr 30 '16 at 21:58
8
$\begingroup$

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

$\endgroup$
0
$\begingroup$

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 defining 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.

$\endgroup$

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.