8
$\begingroup$

Given a list of InfiniteLine, i.e., infinitelines and a boundary boundaryc how can we devise a fast way to compute the following intersections?

infinitelines = {InfiniteLine[{{325.650263423383`,240.02743526510483`},{268.2499472430934`, 153.72242101773688`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {275.9903503953653`, 149.04807046250073`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {284.1086954712557`, 145.06612780825483`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {292.5431969627463`, 141.8068980429607`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {301.2296632205957`, 139.295185873109`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {310.10198499154984`, 137.55010694492557`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {319.0926385496775`, 136.58494236276135`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {328.13319959269614`, 136.4070376118689`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {337.1548639922285`, 137.01774665482435`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {346.0889714347642`, 138.41242162705458`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {354.8675279681039`, 140.58044820989318`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {363.4237234763916`, 143.50532641195446`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {371.69244014543716`,147.16479614403102`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {379.61074804860147`, 151.5310066318135`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {387.1183840815364`, 156.57072837709995`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {394.1582106007968`, 162.24560605434152`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {400.67665027580756`, 168.51245041782957`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {406.6240938447004`, 175.32356699793388`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {411.9552776707514`, 182.6271190848152`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {416.6296282259875`, 190.36752223708706`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {420.6115708802334`, 198.48586731297746`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {423.8708006455275`, 206.92036880446807`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {426.3825128153792`, 215.60683506231743`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {428.1275917435626`, 224.47915683327156`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {429.0927563257269`, 233.46981039139916`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {429.2706610766194`, 242.51037143441783`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {428.6599520336639`, 251.53203583395015`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {427.26527706143366`, 260.4661432764858`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {425.0972504785951`, 269.24469980982553`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {422.1723722765338`, 277.8008953181133`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {418.5129025444572`, 286.06961198715885`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {414.1466920566747`, 293.98791989032316`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {409.10697031138824`, 301.4955559232581`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {403.43209263414667`, 308.5353824425185`}}],
InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {397.16524827065865`, 315.0538221175292`}}],InfiniteLine[{{325.650263423383`, 240.02743526510483`}, {390.35413169055437`, 321.0012656864221`}}]};

Boundaries

boundaryc = {{334, 346}, {333, 345}, {332, 345}, {331, 345}, {330,345},
{329, 345}, {328, 345}, {327, 345}, {326, 345}, {325, 345}, {324, 345},
{323, 345}, {322, 345}, {321, 345}, {320, 345}, {319, 345}, {318, 345},
{317, 345}, {316, 345}, {315, 345}, {314, 345}, {313, 345}, {312, 345},
{311, 344}, {311, 345}, {310, 344}, {309, 344}, {308, 344}, {307, 344},
{307, 343}, {306, 343}, {305, 343}, {304, 343}, {303, 343}, {302, 343},
{301, 342}, {301, 343}, {300, 342}, {299, 342}, {298, 342}, {298, 341},
{297, 341}, {296, 341}, {295, 341}, {294, 341}, {293, 341}, {292, 340},
{292, 341}, {291, 340}, {290, 340}, {289, 340}, {288, 339}, {288, 340},
{287, 339}, {287, 338}, {286, 338}, {285, 338}, {284, 338}, {283, 338},
{283, 337}, {282, 337}, {281, 336}, {281, 337}, {280, 336}, {280, 335},
{279, 335}, {278, 335}, {278, 334}, {277, 334}, {276, 334}, {275, 333},
{276, 333}, {275, 332}, {274, 332}, {273, 332}, {273, 331}, {272, 331},
{271, 331}, {271, 330}, {270, 330}, {269, 330}, {268, 329}, {269, 329},
{268, 328}, {267, 328}, {266, 327}, {266, 328}, {265, 327}, {264, 327},
{263, 326}, {264, 326}, {263, 325}, {262, 325}, {261, 325}, {260, 324},
{261, 324}, {260, 323}, {259, 323}, {258, 323}, {258, 322}, {257, 321},
{257, 322}, {256, 321}, {255, 321}, {254, 320}, {255, 320}, {254, 319},
{253, 319}, {252, 319}, {252, 318}, {251, 317}, {251, 318}, {250, 317},
{250, 316}, {249, 316}, {249, 315}, {248, 315}, {248, 314}, {247, 314},
{247, 313}, {246, 313}, {245, 312}, {246, 312}, {245, 311}, {244, 310},
{244, 311}, {243, 310}, {243, 309}, {243, 308}, {242, 308}, {241, 307},
{242, 307}, {241, 306}, {241, 305}, {240, 305}, {240, 304}, {239, 304},
{238, 303}, {239, 303}, {238, 302}, {237, 302}, {237, 301}, {237, 300},
{236, 300}, {236, 299}, {235, 299}, {234, 298}, {235, 298}, {234, 297},
{233, 297}, {233, 296}, {232, 295}, {233, 295}, {232, 294}, {232, 293},
{232, 292}, {232, 291}, {231, 291}, {231, 290}, {231, 289}, {231, 288},
{230, 288}, {230, 287}, {230, 286}, {230, 285}, {230, 284}, {229, 284},
{228, 283}, {229, 283}, {228, 282}, {228, 281}, {227, 281}, {227, 280},
{227, 279}, {226, 279}, {226, 278}, {226, 277}, {226, 276}, {225, 276},
{225, 275}, {225, 274}, {225, 273}, {225, 272}, {224, 272}, {224, 271},
{224, 270}, {224, 269}, {224, 268}, {224, 267}, {224, 266}, {224, 265},
{223, 264}, {224, 264}, {223, 263}, {223, 262}, {223, 261}, {223, 260},
{222, 260}, {222, 259}, {222, 258}, {222, 257}, {222, 256}, {222, 255},
{221, 254}, {222, 254}, {221, 253}, {221, 252}, {221, 251}, {221, 250},
{220, 250}, {220, 249}, {220, 248}, {220, 247}, {220, 246}, {220, 245},
{220, 244}, {220, 243}, {220, 242}, {220, 241}, {220, 240}, {220, 239},
{220, 238}, {220, 237}, {220, 236}, {220, 235}, {220, 234}, {220, 233},
{220, 232}, {220, 231}, {220, 230}, {220, 229}, {220, 228}, {220, 227},
{220, 226}, {221, 225}, {220, 225}, {221, 224}, {221, 223}, {221, 222},
{221, 221}, {221, 220}, {221, 219}, {222, 219}, {222, 218}, {222, 217},
{222, 216}, {223, 215}, {222, 215}, {223, 214}, {223, 213}, {223, 212},
{223, 211}, {224, 210}, {224, 211}, {225, 210}, {225, 209}, {225, 208},
{225, 207}, {225, 206}, {226, 206}, {226, 205}, {227, 204}, {226, 204},
{227, 203}, {228, 203}, {228, 202}, {228, 201}, {229, 201}, {229, 200},
{229, 199}, {230, 198}, {229, 198}, {230, 197}, {230, 196}, {230, 195},
{230, 194}, {231, 194}, {231, 193}, {232, 192}, {231, 192}, {232, 191},
{233, 191}, {233, 190}, {233, 189}, {234, 189}, {234, 188}, {235, 187},
{234, 187}, {235, 186}, {235, 185}, {236, 185}, {236, 184}, {237, 183},
{236, 183}, {237, 182}, {238, 181}, {238, 182}, {239, 181}, {239, 180},
{240, 180}, {240, 179}, {241, 179}, {242, 179}, {243, 178}, {242, 178},
{243, 177}, {244, 176}, {244, 177}, {245, 176}, {245, 175}, {245, 174},
{246, 174}, {246, 173}, {247, 173}, {247, 172}, {248, 171}, {248, 172},
{249, 171}, {249, 170}, {250, 169}, {250, 170}, {251, 169}, {252, 168},
{251, 168}, {252, 167}, {253, 167}, {254, 166}, {253, 166}, {254, 165},
{255, 165}, {255, 164}, {256, 163}, {256, 164}, {257, 163}, {257, 162},
{258, 161}, {258, 162}, {259, 161}, {259, 160}, {260, 159}, {260, 160},
{261, 159}, {261, 158}, {262, 158}, {263, 158}, {263, 157}, {264, 157},
{265, 157}, {265, 156}, {266, 156}, {266, 155}, {267, 155}, {268, 155},
{268, 154}, {269, 154}, {270, 153}, {270, 154}, {271, 153}, {271, 152},
{272, 152}, {273, 152}, {273, 151}, {274, 150}, {274, 151}, {275, 150},
{276, 150}, {276, 149}, {277, 148}, {277, 149}, {278, 148}, {279, 148},
{280, 147}, {279, 147}, {280, 146}, {281, 146}, {282, 146}, {282, 145},
{283, 145}, {284, 145}, {284, 144}, {285, 144}, {286, 144}, {287, 143},
{287, 144}, {288, 143}, {289, 143}, {289, 142}, {290, 142}, {291, 142},
{292, 142}, {293, 142}, {293, 141}, {294, 141}, {295, 141}, {296, 141},
{297, 141}, {297, 140}, {298, 140}, {299, 139}, {299, 140}, {300, 139},
{301, 139}, {302, 139}, {303, 139}, {303, 138}, {304, 138}, {305, 138},
{306, 138}, {307, 138}, {307, 137}, {308, 137}, {309, 137}, {310, 137},
{311, 137}, {311, 136}, {312, 136}, {313, 136}, {314, 136}, {315, 135},
{315, 136}, {316, 135}, {317, 135}, {318, 134}, {318, 135}, {319, 134},
{320, 134}, {321, 134}, {322, 134}, {323, 134}, {324, 134}, {325, 134},
{326, 134}, {326, 133}, {327, 133}, {328, 133}, {329, 133}, {329, 134},
{330, 134}, {331, 134}, {332, 134}, {333, 134}, {334, 134}, {335, 134},
{336, 134}, {337, 134}, {338, 134}, {339, 134}, {340, 134}, {341, 134},
{342, 134}, {343, 134}, {344, 134}, {344, 135}, {345, 135}, {346, 135},
{347, 135}, {348, 136}, {348, 135}, {349, 136}, {350, 136}, {351, 136},
{352, 136}, {352, 137}, {353, 137}, {354, 137}, {355, 137}, {356, 137},
{356, 138}, {357, 138}, {358, 139}, {358, 138}, {359, 139}, {360, 139},
{361, 139}, {362, 140}, {362, 139}, {363, 140}, {364, 140}, {364, 141},
{365, 141}, {366, 141}, {366, 142}, {367, 142}, {368, 142}, {369, 142},
{370, 143}, {370, 142}, {371, 143}, {372, 143}, {372, 144}, {373, 144},
{374, 144}, {375, 144}, {375, 145}, {376, 145}, {377, 145}, {377, 146},
{378, 146}, {378, 147}, {379, 147}, {379, 148}, {380, 149}, {380, 148},
{381, 149}, {382, 150}, {382, 149}, {383, 150}, {384, 151}, {384, 150},
{385, 151}, {385, 152}, {386, 152}, {386, 153}, {387, 153}, {387, 154},
{388, 154}, {389, 155}, {389, 154}, {390, 155}, {391, 155}, {391, 156},
{392, 156}, {393, 156}, {393, 157}, {394, 157}, {395, 158}, {395, 157},
{396, 158}, {397, 159}, {396, 159}, {397, 160}, {398, 160}, {398, 161},
{399, 161}, {399, 162}, {400, 162}, {401, 163}, {400, 163}, {401, 164},
{401, 165}, {402, 165}, {402, 166}, {402, 167}, {403, 168}, {403, 167},
{404, 168}, {404, 169}, {405, 169}, {405, 170}, {406, 171}, {406, 170},
{407, 171}, {407, 172}, {407, 173}, {408, 173}, {408, 174}, {409, 174},
{409, 175}, {410, 175}, {410, 176}, {411, 176}, {412, 177}, {411, 177},
{412, 178}, {412, 179}, {413, 179}, {413, 180}, {414, 180}, {414, 181},
{415, 181}, {416, 182}, {415, 182}, {416, 183}, {416, 184}, {416, 185},
{417, 186}, {416, 186}, {417, 187}, {417, 188}, {418, 188}, {418, 189},
{418, 190}, {418, 191}, {418, 192}, {419, 192}, {419, 193}, {419, 194},
{419, 195}, {419, 196}, {420, 197}, {420, 196}, {421, 197}, {421, 198},
{422, 199}, {421, 199}, {422, 200}, {423, 201}, {422, 201}, {423, 202},
{424, 203}, {423, 203}, {424, 204}, {424, 205}, {425, 206}, {425, 205},
{426, 206}, {426, 207}, {426, 208}, {427, 208}, {427, 209}, {427, 210},
{428, 210}, {429, 211}, {428, 211}, {429, 212}, {429, 213}, {429, 214},
{430, 215}, {429, 215}, {430, 216}, {430, 217}, {430, 218}, {431, 218},
{431, 219}, {431, 220}, {431, 221}, {431, 222}, {431, 223}, {431, 224},
{431, 225}, {431, 226}, {432, 226}, {432, 227}, {432, 228}, {432, 229},
{432, 230}, {432, 231}, {432, 232}, {432, 233}, {432, 234}, {432, 235},
{432, 236}, {433, 236}, {433, 237}, {433, 238}, {433, 239}, {433, 240},
{433, 241}, {433, 242}, {433, 243}, {433, 244}, {433, 245}, {433, 246},
{433, 247}, {432, 248}, {433, 248}, {432, 249}, {432, 250}, {431, 251},
{432, 251}, {431, 252}, {431, 253}, {431, 254}, {431, 255}, {431, 256},
{431, 257}, {431, 258}, {431, 259}, {431, 260}, {430, 261}, {431, 261},
{430, 262}, {430, 263}, {430, 264}, {430, 265}, {430, 266}, {430, 267},
{429, 267}, {429, 268}, {429, 269}, {429, 270}, {429, 271}, {428, 271},
{428, 272}, {427, 273}, {428, 273}, {427, 274}, {427, 275}, {426, 276},
{427, 276}, {426, 277}, {425, 278}, {426, 278}, {425, 279}, {425, 280},
{424, 281}, {424, 280}, {423, 281}, {423, 282}, {423, 283}, {423, 284},
{422, 285}, {423, 285}, {422, 286}, {422, 287}, {421, 287}, {421, 288},
{420, 289}, {421, 289}, {420, 290}, {420, 291}, {419, 291}, {419, 292},
{419, 293}, {418, 293}, {418, 294}, {418, 295}, {417, 295}, {417, 296},
{416, 297}, {417, 297}, {416, 298}, {415, 298}, {415, 299}, {414, 299},
{413, 300}, {414, 300}, {413, 301}, {412, 302}, {412, 301}, {411, 302},
{411, 303}, {410, 303}, {409, 304}, {410, 304}, {409, 305}, {409, 306},
{408, 307}, {408, 306}, {407, 307}, {407, 308}, {406, 308}, {406, 309},
{405, 310}, {405, 309}, {404, 310}, {403, 310}, {403, 311}, {402, 311},
{402, 312}, {401, 313}, {401, 312}, {400, 313}, {400, 314}, {399, 314},
{399, 315}, {398, 315}, {397, 315}, {396, 316}, {397, 316}, {396, 317},
{395, 317}, {394, 318}, {395, 318}, {394, 319}, {393, 319}, {393, 320},
{392, 320}, {391, 321}, {392, 321}, {391, 322}, {390, 322}, {390, 323},
{389, 323}, {389, 324}, {388, 324}, {387, 324}, {386, 325}, {387, 325},
{386, 326}, {385, 326}, {385, 327}, {384, 327}, {384, 328}, {383, 328},
{382, 328}, {381, 329}, {382, 329}, {381, 330}, {380, 331}, {380, 330},
{379, 331}, {379, 332}, {378, 333}, {378, 332}, {377, 333}, {376, 333},
{375, 334}, {376, 334}, {375, 335}, {374, 336}, {374, 335}, {373, 336},
{373, 337}, {372, 337}, {371, 337}, {371, 338}, {370, 338}, {369, 339},
{369, 338}, {368, 339}, {368, 340}, {367, 340}, {366, 341}, {366, 340},
{365, 341}, {364, 342}, {364, 341}, {363, 342}, {362, 342}, {361, 342},
{360, 342}, {360, 343}, {359, 343}, {358, 343}, {357, 343}, {356, 343},
{356, 344}, {355, 344}, {354, 345}, {354, 344}, {353, 345}, {352, 345},
{351, 345}, {350, 345}, {349, 345}, {348, 346}, {348, 345}, {347, 346},
{346, 346}, {345, 346}, {344, 346}, {343, 346}, {342, 346}, {341, 346},
{340, 346}, {339, 346}, {338, 346}, {337, 346}, {336, 346}, {335, 346},
{334, 345}, {334, 346}};

Here are four ways:

lc = (Line@boundaryc);

(* First method *)

(sol1 = (x \[Function] BooleanRegion[And, {x, lc}]) /@ infinitelines); // AbsoluteTiming
(* {44.3802, Null} *)

 (* Second method *)

contour = BlockMap[Line, boundaryc, 2, 1];
(sol2 = (x \[Function] Cases[RegionIntersection[x, #] & /@ contour, _Point]) /@ infinitelines); // AbsoluteTiming

(* {53.1897, Null} *)

(* Third method *)

(sol3 = RegionIntersection[lc, #] & /@ infinitelines); // AbsoluteTiming
(* {44.2825, Null} *)


(* Fourth method *)

(sol4 = ({x, y} /. NSolve[{x, y} \[Element] # \[And] {x, y} \[Element] lc, {x, y}]) & /@ infinitelines); // AbsoluteTiming

(* {93.5564, Null} *)

So far the first and the third method seem to be the fastest.

$\endgroup$
  • 2
    $\begingroup$ Are we allowed to use tricks specific to this problem? e.g. here we could transform the list into polar coordinates, find the angles of the lines, and quickly compute the intersection from that. $\endgroup$ – C. E. Jan 19 '18 at 17:59
  • $\begingroup$ @C.E. You can add that as an answer. But I would prefer not to employ this trick and perhaps rely on some internal optimization perhaps ?? $\endgroup$ – Ali Hashmi Jan 19 '18 at 18:14
  • $\begingroup$ Perhaps some tricks from this thread may be useful. $\endgroup$ – Alexey Popkov Jan 19 '18 at 18:43
  • $\begingroup$ That is a lot of numbers... $\endgroup$ – Peter Mortensen Jan 20 '18 at 0:31
  • $\begingroup$ On my machine the NSolve method is the fastest (Mathematica 11.2.0 on Windows 7 x64, dual core CPU). $\endgroup$ – Alexey Popkov Jan 20 '18 at 1:30
14
$\begingroup$

Using undocumented Graphics`Mesh`FindIntersections we can do this very efficiently:

gr = Graphics[{FaceForm[], EdgeForm[Blue], Polygon[boundaryc], infinitelines}];
intersects = Graphics`Mesh`FindIntersections@gr; // AbsoluteTiming
Show[gr, Epilog -> {Red, PointSize[Large], Point[intersects]}, ImageSize -> 600]
{0.0385294, Null}

output

However according to this question (thanks Michael E2 for the link!) this function sometimes doesn't return all the intersections due to a bug. So it isn't sufficiently reliable for serious applications.

$\endgroup$
  • $\begingroup$ i have upvoted your answer. Will accept it if no one posts in a couple of days. Btw can this approach correctly pair the intersections together? For example, if one of the infinite lines intersect the boundary at two or three places then those intersections are grouped together. Similarly, can intersections for the various lines be grouped together? $\endgroup$ – Ali Hashmi Jan 19 '18 at 21:08
  • $\begingroup$ or mapping over the lines is the only way? $\endgroup$ – Ali Hashmi Jan 19 '18 at 21:09
  • 2
    $\begingroup$ There is this caveat re Graphics`Mesh`FindIntersections: mathematica.stackexchange.com/questions/41496/… $\endgroup$ – Michael E2 Jan 20 '18 at 0:29
10
$\begingroup$

How to do it without high level methods (does not generalize to arbitrary lines and boundaries):

AbsoluteTiming[
 centeredBoundary = N[# - center] & /@ boundaryc;
 polarCoordinates = {ArcTan @@ #, Norm[#]} & /@ centeredBoundary;
 removeDuplicates = DeleteDuplicatesBy[polarCoordinates, First];
 interp = Interpolation[removeDuplicates, InterpolationOrder -> 1];
 angles = infinitelines /. InfiniteLine[{{x1_, y1_}, {x2_, y2_}}] :> ArcTan[x2 - x1, y2 - y1];
 angles = Join[angles, # + Pi & /@ angles];
 radii = interp /@ angles // Quiet;
 pts = center + # & /@ MapThread[# {Cos[#2], Sin[#2]} &, {radii, angles}];
 ]

Graphics[{
  Line[boundaryc],
  infinitelines,
  Red, PointSize[Large],
  Point[pts]
  }, Axes -> True]

{0.006159, Null}

Mathematica graphics

The idea is to move the points so that the center is in the origin and then represent all coordinates in polar coordinates. In this coordinate system it becomes straightforward to map the angle of a given line to a point on the boundary in this coordinate system, which can then be converted back to the original coordinate system.

$\endgroup$
6
$\begingroup$

Here is an image-based approach. The lines are drawn in red, the points in blue, the ImageCompose is used two merge both images with some opacity. The pixels on the intersections can be easily detected, because they are the only ones which are neither red, blue or black.

img1 = ColorNegate@Rasterize[Style[Graphics[{Yellow, Point[boundaryc]}, 
      PlotRange -> {{210, 440}, {120, 360}}], Antialiasing -> False]];
img2 = ColorNegate@Rasterize[Style[Graphics[{Cyan, infinitelines}, 
      PlotRange -> {{210, 440}, {120, 360}}], Antialiasing -> False]];
img3 = ImageCompose[{img1, 0.5}, {img2, 0.5}]

enter image description here

data = ImageData@img3;
tab = PixelValuePositions[img3, {0.4980392156862745`, 0.`, 
                0.4980392156862745`}]

(* tab now has the intersection pixels, to be converted *)

Table[data[[Sequence @@ tab[[i]]]] = {1, 1, 1}, {i, Length@tab}];

Image@data

Converting the white pixels to absolute coordinates is left as an exercise...

Total computation time : 0.5s.

enter image description here

$\endgroup$
6
$\begingroup$

Here is a compiled version of lineIntersection function by J. M. with the following changes:

  1. I replaced LeastSquares with LinearSolve in order to make the function compilable.

  2. I dropped the second point (which lies on the second line originally also assumed to be InfiniteLine, but in our case it is a line segment) in favor of the check whether the first point (which lies on the infinite line) is within the bounding box of the line segment or not.

The first argument is the two-point specification for InfiniteLine, the second argument is starting and ending points of the Line segment:

intersectBoole = Compile[{{p, _Real, 2}, {q, _Real, 2}},
  v = {p[[2]] - p[[1]], q[[2]] - q[[1]]};
  c = q[[1]] - p[[1]];
  sol = LinearSolve[Transpose[v], c];
  {x, y} = p[[1]] + sol[[1]] (p[[2]] - p[[1]]);
  {x, y, Boole[
     Min[q[[All, 1]]] <= x <= Max[q[[All, 1]]] && 
     Min[q[[All, 2]]] <= y <= Max[q[[All, 2]]]]},
  RuntimeAttributes -> {Listable}]

The third element returned is a Boolean value which indicates whether the intersection point lies inside of the bounding box of the line segment or not. If the point is inside, then the infinite line intersects the segment, if outside – does not intersect.

Having this in mind we can proceed as follows:

lineSegments = Partition[boundaryc, 2, 1];
intersectionPointsGrouped = 
  Cases[intersectBoole[#, lineSegments], {x_, y_, 1.} :> {x, y}] & /@ 
   infinitelines[[All, 1]];

Visualization:

Graphics[{FaceForm[], EdgeForm[Blue], Polygon[boundaryc], infinitelines, Red, 
  PointSize[Large], Point[Flatten[intersectionPointsGrouped, 1]]}, ImageSize -> 600]

graphics

Timings are already moderate. If further speed-up is needed, one can include the selection routine into the compiled function.


UPDATE

Here is an implementation which doesn't use compilation but nevertheless is about 11% faster than the previous compiled attempt, because here LinearSolve solves one system of linear equations for each InfiniteLine; it also correctly handles the situations when lines are parallel or coincide with the InfiniteLine specs:

intersections[infLine : {p1_, p2_}, segs : {{_, _} ..}] := 
  Module[{v1, v1N, v2l, cl, len, parallelQl, s, inters, checks, sols},
   v1 = p2 - p1; v2l = segs[[All, 2]] - segs[[All, 1]]; 
   cl = Flatten[# - p1 & /@ segs[[All, 1]]];
   len = Length[segs]; v1N = Normalize[v1];
   parallelQl = Table[Abs[v1N.Normalize[v2l[[i]]]] == 1, {i, len}];
   s = SparseArray[
     Table[Band[{2 i - 1, 2 i - 1}] -> 
       If[! parallelQl[[i]], Transpose[{v1, v2l[[i]]}], segs[[i]]], {i, 1, len}], {len*2, len*2}];
   sols = LinearSolve[s, cl];
   inters = Table[p1 + sols[[2 i - 1]] v1, {i, 1, len}];
   checks = 
    Table[Not@parallelQl[[i]] && 
      Min[segs[[i, All, 1]]] <= inters[[i, 1]] <= Max[segs[[i, All, 1]]] && 
      Min[segs[[i, All, 2]]] <= inters[[i, 2]] <= Max[segs[[i, All, 2]]], {i, 1, len}];
   DeleteDuplicates[Chop[Pick[inters, checks]]]];

lineSegments = Partition[boundaryc, 2, 1];
intersections[#, lineSegments] & /@ infinitelines[[All, 1]];

intersectionPointsGrouped == %
True

Further speed up is possible by constructing one matrix for all InfiniteLines and segments and solving it at once. Also usage of IntervalMemberQ as shown here can be advantageous.

$\endgroup$
2
$\begingroup$

One idea is to find the intersection of one infinite line with the infinite line extension of the second line, and then determine whether the point is on the second line. The following gives the intersection point of two infinite lines:

First @ RegionIntersection[
    InfiniteLine[{{w, x}, {y, z}}],
    InfiniteLine[{{a, b}, {c, d}}]
]

{a + ((-a + c) (-b w + a x + b y - x y - a z + w z))/(-b w + d w + a x - c x + b y - d y - a z + c z), b + ((-b + d) (-b w + a x + b y - x y - a z + w z))/(-b w + d w + a x - c x + b y - d y - a z + c z)}

There is an issue when the denominator is 0, which occurs when two lines are parallel. So, instead I will multiply everything by the denominator and then find out whether the scaled point is on the scaled second line. The following code carries out this idea:

InfiniteLineIntersection[InfiniteLine[{p1_,p2_}]] := ILIntersectionFunction[
    With[{t={p1[[1]]-p2[[1]], p2[[2]]-p1[[2]]}, o={0., p1[[2]]p2[[1]]-p1[[1]]p2[[2]]}}, 
        Function[t . {{#4, #2}, {#3, #1}} + o]
    ]
]

ILIntersectionFunction[dn_][a_, b_, c_, d_] := Module[
    {db = d-b, ca = c-a, den, s, x, y, range, aden, bden},

    {den, s} = dn[a, b, ca, db];
    aden = a den;
    bden = b den;
    x = aden - ca s;
    y = bden - db s;

    range = Pick[
        Range@Length@a,
        inRange[aden, bden, c den, d den, x, y],
        1
    ];

    Transpose[{x[[range]], y[[range]]}] / den[[range]]
]

i_ILIntersectionFunction[Line[a:{{_?NumericQ,_}, __}]] := i[
    a[[;;-2, 1]], a[[;;-2, 2]], a[[2;;, 1]], a[[2;;, 2]]
]

inRange[x1_, y1_, x2_, y2_, x_, y_] := UnitStep[(x1-x)(x-x2)] UnitStep[(y1-y)(y-y2)]

The inRange function comes from my answer to Fast function to do multiple rectangle region checks. Here I use the above code for your problem:

r = InfiniteLineIntersection /@ infinitelines;
pts = Through[r[Line[boundaryc]]]; //AbsoluteTiming

{0.013813, Null}

Visualization:

Graphics[{
    Line[boundaryc],
    LightGray, infinitelines,
    Red, Point[Flatten[pts,1]]
}]

enter image description here

$\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.