# Tag Info

11

You could try this: Clear[interQ]; interQ[ Line[{v1_?VectorQ, v2_?VectorQ}], Line[{v3_?VectorQ, v4_?VectorQ}]] := Block[{ m = Transpose[ {v1 - v2, v4 - v3}], vL}, If[ Det[m] == 0, False, vL = LeastSquares[ m , v4 - v2]; (* Sow[ v1*vL[] + v2*(1-vL[])]; *) 0 <= vL[] <= 1 && 0 <= vL[] <= 1]]...

10

In 2D (and only there), you can use the undocumented function GraphicsMeshFindIntersections to find the point of intersection. This is often an order of magnitude faster than RegionIntersection. If there isn't any intersection point, then an empty list is returned. plot[l1_, l2_] := Graphics[{Thick, PointSize[0.025], Darker@Green, Point @@ l1, l1, Darker@...

9

t := RandomReal[{-10, 10}, 2] ln1 and ln2 will be the coordinates for a Line or InfiniteLine as needed later. ln1 = {t, t}; ln2 = {t, t}; Clear[sol, x, y] sol = Solve[{x, y} \[Element] InfiniteLine@ln1 \[And] {x, y} \[Element] InfiniteLine@ln2, {x, y}] {x, y} = {x, y} /. sol[] Let's say this gives us the following pt of intersection for ...

8

This answer provides results of timing tests of the other answers, at least the ones that provided compatible MMA code. The test methods are shown below. With a smaller number indicating a faster method of determining whether the line segments intersect, here is a summary of the latest results: \begin{array}{cc} \text{Original} & 1.207 \\ \text{...

8

How about negating the output of RegionDisjoint? Borrowing a specific example from the ref page: SeedRandom; l1 = Line[{{0, 0}, {1, 1}}]; l2 = Line[RandomReal[1, {10, 2}]]; !RegionDisjoint[l1, l2] // AbsoluteTiming {0.002878, False}

5

Here is an attempt at a step by step solution starting from the points in the post by @cvmgt. pts = {{1, 0}, {3, 0}, {2, 1}, {2, 2}, {3, 3}, {4, 3}, {5, 2}, {5, 1}, {4, 0}, {5, 0}, {5, -1}, {1, -1}}; reg1 = WindingPolygon[pts]; RegionPlot[reg1] reg2 = Region@TranslationTransform[{4, 0}][reg1]; reg3 = Region@TranslationTransform[{4, 0}][reg2]; reg4 = ...

4

You can also use Reap and Sow. For example: f[x_, y_, u_] := x^2 + y^2 - u^2/10^2*x^2*y^2; man[u_, t_, n_, d_] := Module[{grid = Tuples[Range[-n, n, d], 2], pts}, pts = Point[ Reap[Sow[{##}, f[##, u] <= t] & @@@ grid, True][[2, 1]]]; RegionPlot[f[x, y, u] <= t, {x, -n, n}, {y, -n, n}, Epilog -> pts]] Then, Manipulate[man[u, 100, 10, 1],...

3

Do you mean this? pts2 = {{1, 0}, {3, 0}, {2, 1}, {2, 2}, {3, 3}, {4, 3}, {5, 2}, {5, 1}, {4, 0}, {5, 0}, {5, -1}, {1, -1}}; pts3 = PadRight[pts2, {Automatic, 3}]; reg = Polygon[pts3]; Graphics3D[reg] Edit Thanks @Syed provide the example. pts2 = {{1, 0}, {3, 0}, {2, 1}, {2, 2}, {3, 3}, {4, 3}, {5, 2}, {5, 1}, {4, 0}, {5, 0}, {5, -1}, {1, -1}}; ...

3

R1[p, q] := m p + (1 - m) q; R2[p, q] := n p + (1 - n) q; Test[pts] := And[(0 <= m <= 1), (0 <= n <= 1)] /. Solve[R1[pts[], pts[]] == R2[pts[], pts[]], {m, n}]; Draw[pts] := Graphics[{Line[{pts[], pts[]}], Line[{pts[], pts[]}]}]; {Test[#][], Draw[#]} &@RandomReal[{-1, 1}, {4, 2}] // Timing

3

Clear["Global`*"] $Version (* "12.3.1 for Mac OS X x86 (64-bit) (June 19, 2021)" *) SeedRandom; rgn3 = ImplicitRegion[ x^2 + y^2 - u^2/10^2*x^2*y^2 <= 100, {{x, -10, 10}, {y, -10, 10}, {u, 0.1, 0.99999}}]; For random {x, y, u} points that are in the region rgn3 TableForm[ pts3 = RandomPoint[rgn3, 10], TableHeadings ... 2 pts = Flatten[#, 1] &@Table[{x, y}, {x, -10, 10, 0.5}, {y, -10, 10, 0.5}]; Manipulate[ \[ScriptCapitalR] = ImplicitRegion[ x^2 + y^2 - (u^2/10^2) x^2*y^2 <= 100 /. u -> k, {x, y}]; (*Echo[\[ScriptCapitalR]];*) ptsinreg = Pick[pts, ! RegionDisjoint[\[ScriptCapitalR], Point[#]] & /@ pts]; (*Echo[ptsinreg];*) p1 = ListPlot[... 2 The line (AB) intersects the inner part of a non-collinear segment [CD] iff (AB × AC)(AB × AD) < 0 (here × stands for the 2D vector product — which are equal to determinants). Moreover, the non-collinear segments [AB] and [BC] intersect iff the line (AB) intersects [CD], and the line (CD) intersects [AB]. In non-collinear case, the same holds when one ... 2 We can parametrize the first line segment on the parameter interval$t \in [0,1]$and the second on the parameter interval$s \in [0,1]\$, then use Solve to find the intersection, restricting to those two intervals. If there is no intersection, Solve returns an empty list, so the Length of the result is zero. If there is a single point of intersection, ...

1

Combining the FindRoot usage suggested by @DerekH with manipulate: Manipulate[ sol = FindRoot[{eq1, eq2}, {{x, xcoord}, {y, ycoord}}]; Show[{ContourPlot[Evaluate@{eq1, eq2}, {x, -10, 10}, {y, -10, 10}, PlotLabel -> Style[sol, Red, Bold], GridLines -> Automatic], Graphics[{Red, PointSize[Medium], Point[{x, y} /. sol]}] }], {{xcoord, 0}, 0, ...

1

Restricting y too, we succeed: NSolve[{eq1, eq2, x >= 0.01, x <= 0.5, y >= -5, y <= 5}, {x, y}, Reals] or NSolve[{eq1, eq2, x \[Element] Interval[{0.01, 0.5}], y >= -5, y <= 5}, {x, y}, Reals] {{x -> 0.0117594, y -> 0.418582}}

Only top voted, non community-wiki answers of a minimum length are eligible