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]] == #2[[1]] &, # ]][[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}], #[[1]] != #[[2]] &]
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]]}] /@ #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
