# Tag Info

9

You can extract the polygons in llp using Cases: llp = ListLinePlot[{{1, 2, 4, 3, 1}, {3, 6, 5, 1, 0}}, Filling -> {1 -> {2}}]; polygons = Cases[Normal@llp, _Polygon, All] {Polygon[{{1.,1.},{2.,2.},{3.,4.},{3.33333,3.66667},{3.33333,3.66667},{3.,5.},{2.,6.},{1.,3.}}], Polygon[{{3.33333,3.66667},{4.,1.},{5.,0.},{5.,1.},{4.,3.},{3.33333,3.66667}...

8

ClusteringComponents does what you want; maybe play with the DistanceFunction and other options: ClusteringComponents[pts, Length[pts], 1] (* {1, 2, 3, 3, 4, 4} *)

8

Coding the square root in polynomial terms yields the result in 0.06 sec. on my laptop: Minimize[{u + v, u^2 == 3 + x && v^2 == 3 - x*y && x^2 + y^2 == 9 && u >= 0 && v >= 0}, {x, y, u, v}] (* {Root[9 - 54 #1^2 + 45 #1^4 - 12 #1^6 + #1^8 &, 5], {x -> -3 + Root[9 - 54 #1^2 + 45 #1^4 - 12 #1^6 + #1^8 &...

6

First of all, I observed that your matrix can be represented as KroneckerProduct of smaller matrixes which are themselfes KroneckerProduct (or TensorProducts) of vectors: Ux = Table[m^2 Sin[m x], {m, 1, k}]; Vx = Table[p^2 Sin[p x], {p, 1, k}]; Uy = Table[Sin[n y], {n, 1, k}]; Vy = Table[Sin[q y], {q, 1, k}]; Ax = KroneckerProduct[Ux, Vx]; Ay = ...

5

Here's a refactoring of the OP's code & Rolf's compile idea. Basically I tried to implement the idea in my comment: Also, BesselJ is not compilable, so it slows down the compiled function with call-backs to the main kernel. You could pass a list of Bessel function values as an argument to Compile. This would reduce the number of Bessel function calls ...

5

Using Compile speeds things up: λ = 0.500; k = (2 π)/λ; ρ[x_, y_] := Sqrt[x^2 + y^2]; ϕ[x_, y_] := ArcTan[x, y]; Ε2[n_, x_, y_, z_] := Exp[I k z + I n ϕ[x, y] + (I k ρ[x, y]^2)/(4 z)]* Sqrt[π/2]*(-I)^(Abs[n]/2)*Sqrt[(k*ρ[x, y]^2)/(4 z)]*(BesselJ[(Abs[n] - 1)/2, (k ρ[x, y]^2)/(4 z)] - I*BesselJ[(Abs[n] + 1)/2, (k ρ[x, y]^2)/(4 z)]); U = With[{expr = ((Exp[I*...

3

expr = Sqrt[3 + x] + Sqrt[3 - x*y]; fd = FunctionDomain[{expr, x^2 + y^2 == 9}, {x, y}] // FullSimplify (* x y <= 3 && x^2 + y^2 == 9 *) Plot the function to find additional constraints on x and y to use in the Minimize Plot3D[expr, {x, -3, 3}, {y, -3, 3}, RegionFunction -> (#1^2 + #2^2 <= 9 &), AxesLabel -> Automatic] ...

3

It can do it if you give additional constraints and break the problem into 3 cases. ClearAll[x, y]; Minimize[{Sqrt[3 + x] + Sqrt[3 - x*y], x^2 + y^2 == 9 && x > 0}, {x, y}]//N (* {2.01754, {x -> 1.07047, y -> 2.80252}} *) So by giving different combinations, it can give all answers Minimize[{Sqrt[3 + x] + Sqrt[3 - x*y], x^2 + y^2 == 9 &...

3

lst1 = {{1, 4}, {2, 7}, {4, 6}, {5, 2}, {6, 5}, {7, 1}}; lst2 = {{1, 2}, {2, 5}, {3, 1}, {5, 7}, {6, 3}, {7, 6}}; 1. An alternative method using FindCycle and RelationGraph: ClearAll[findCycl1] findCycl1 = FindCycle[RelationGraph[#[] == #2[] &, # ]][[1, ;; , 1]] &; findCycl1 /@ {lst1, lst2} {{{1, 4}, {4, 6}, {6, 5}, {5, 2}, {2, 7}, {7, 1}...

2

Applying SparseArray`SparseArraySort to jSparse3 will make it the same as jSparse1 and jSparse2. Also notice that jSparse1 == jSparse3 returns True. SameQ (===) compares the internal structure of the SparseArrays, which are the "ColumnIndices", "RowPointers", "NonzeroValues", and "Background" properties. At least, that's the defining properties for vectors ...

2

One could also go with a fully analytical approach: l1 = {1, 2, 4, 3, 1}; l2 = {3, 6, 5, 1, 0}; s1 = Subsequences[l1, {2}]; s2 = Subsequences[l2, {2}]; s = Transpose[{s1, s2}]; Edit: to avoid the code breaking when a polygon has area = 0, one can replace s with: s = Select[Transpose[{s1, s2}], #[] != #[] &] To speed up computation, one might ...

1

A possible solution for this particular case of gathering index of points which are near to other points: PointGatherBy[pts_, tol_] := Values@PositionIndex@ Merge[Flatten[ MapIndexed[Function[s, s -> {Length@#1, #2[]}] /@ #1 &, Flatten[Values[ PositionIndex[ Round[Transpose[Transpose[pts] + #], tol]]] & /@ ...

1

In fact, you can compute the exact answer for this case if you explicitly assemble the piecewise linear function representing the two "connect-the-dots" plots in the OP, and then feed the integrand to Integrate[]. Here's one way to derive the required piecewise linear interpolant: makePW[ya_?VectorQ, t_] := Piecewise[MapIndexed[{InterpolatingPolynomial[...

1

Using march's general idea to treat the pairs as a list of graph edges: List @@@ First[FindCycle[Rule @@@ {{1, 4}, {2, 7}, {4, 6}, {5, 2}, {6, 5}, {7, 1}}]] {{1, 4}, {4, 6}, {6, 5}, {5, 2}, {2, 7}, {7, 1}} List @@@ First[FindCycle[Rule @@@ {{1, 2}, {2, 5}, {3, 1}, {5, 7}, {6, 3}, {7, 6}}]] {{1, 2}, {2, 5}, {5, 7}, {7, 6}, {6, 3}, {3, 1}}

1

It's been a while since this question was asked but perhaps a sketch of an answer is useful for future reference. In version 12.0 FindRoot got a new method option for an Affine Corvariant Newton solver that is fairly efficient for large scale sets of equations. It achieves this performance by making use of a few tricks. It's optimized to use minimal ...

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