New answers tagged mathematical-optimization
0
(Too long for a comment)
The basic issue is that evaluating Plus does automatic threading when given an explicit matrix (for example, IdentityMatrix[4] + expr).
One way to work around the threading behavior for this particular case would be something like
A = RandomVariate[NormalDistribution[], {4, 4}];
ConvexOptimization[-Log[Det[B + A . X . Transpose[A]]], ...
22
Phew, this became more complex than I thought because the objective is not quadratic (as I had first expected). Here some preparations for an efficient evaluation of the energy and its first two derivatives:
Module[{d, PP, P, e, energy, L},
d = 3;
PP = Table[Compile`GetElement[P, Compile`GetElement[e, i], j], {i, 1, 2}, {j, 1, d}];
energy = (Sqrt[Dot[...
0
If I correctly understand the question, this can be done as follows.
We create a a random point set in four dimensions and choose all its triples.
points = RandomReal[{-1, 1}, {50, 3}];
subsets = Subsets[points, {3}];
Let p be a given point presented as a list of one element.
p = {{2, 1, -3}};
Now we create a list of volumes of all the simplexes around p
t ...
2
As far as I remember Lagrangeformalism (classic form) is only valid for generalized coordinates, which fullfill the constraints . In your example x[t],y[t] aren't generalized coordinates!
For the constraint 2 x[t]^2 + 3 y[t]^2 ==1^2 possible generalized coordinate q[t] would be x[t]->Cos[q[t]]/Sqrt[2],y[t]->Sin[q[t]]/Sqrt[3]
2 x[t]^2 + 3 y[t]^2 ==1^2 ...
2
I wonder if the issue is just that of lack of numerical precision and/or there are multiple solutions that give the same minimum. Consider the pieces of your code as error (the function being minimized), constraints, and vars.
Using NMinimize:
results = Table[10^i NMinimize[{error/10^i, constraints}, vars][[1]], {i, 6, 10}]
[![Unbounded error message][1]][1]...
2
Using
QuadraticOptimization[error, constraints, vars, Method -> "COIN",
Tolerance -> 0.000001]
(possibly tweaking the Tolerance) instead gives good answers.
1
Here is a different approach that may raise some issues with the Question itself. As I noted in comments above, the functions listed in the question are quite noisy, and FindMinimum does not converge in any reasonable amount of time. Consequently, as suggested by the OP in a comment above, JimB in his answer used an alternative function,
e[y_?NumericQ, d_] ...
2
You might consider a single function for calculating the entropy values:
e[y_?NumericQ, d_] := Module[{skd, dmin, dmax, g},
skd = SmoothKernelDistribution[d, y];
{dmin, dmax} = MinMax[d] + 3.9 y {-1, 1};
g = PDF[skd, a][[1, 1, 1]];
NIntegrate[-g Log[g], {a, dmin, dmax}]]
Rather than integrating from $-\infty$ to $\infty$, I've used 3.9 times the ...
2
I try the "old" method again:
Fn[eps_, q_, p_] :=
1/3 (1 - eps) (Cos[2 p Pi] + Cos[2 Pi q] + Cos[2 Pi (p + q)]) +
1/3 eps (Cos[4 p Pi] + Cos[2 Pi (p - q)] + Cos[2 Pi (2 p + q)]);
pts = FindInstance[{Grad[Fn[1, q, p], {q, p}] == 0, 0 < q < 1 && 0 < p < 1}, {q, p}, 10] // N;
criticalpts = Thread@{Fn[1, q, p] /. pts, pts}
...
2
You can also get the anylytical result with Minimize
Fn[eps_, q_, p_] =
1/3 (1 - eps) (Cos[2 p Pi] + Cos[2 Pi q] + Cos[2 Pi (p + q)]) +
1/3 eps (Cos[4 p Pi] + Cos[2 Pi (p - q)] + Cos[2 Pi (2 p + q)]);
{min = Minimize[{Fn[1, q, p], 0 < q < 1 && 0 < p < 1}, {p, q}],
min // N}
(* {{1/3 (Cos[
4 (\[Pi] +
ArcTan[AlgebraicNumber[
...
4
NMinimize[{Fn[1, q, p], 0 < q < 1 && 0 < p < 1}, {q, p},
Method -> #] & /@ {Automatic, "NelderMead", "RandomSearch",
"DifferentialEvolution", "SimulatedAnnealing"}
%[[;; , 1]]
{-0.333333, -0.333333, -0.905075, -0.905075, -0.905075}
1
If you are trying to solve a system of equations for a set of unknowns, you need to provide Mathematica with all of the equations at once and tell it to solve for all of the unknowns. Also note that you need to take the derivatives with respect to all three variables, not just x.
Solve[{D[L[x, y, λ], x] == 0, D[L[x, y, λ], y] == 0, D[L[x, y, λ], λ] == 0}, {...
2
Use arbitrary precision rather than machine precision
Clear["Global`*"]
$Version
(* "12.3.1 for Mac OS X x86 (64-bit) (June 19, 2021)" *)
expr = (-0.1 x1 + x2 + 1.2 x3 + x4 - x5)^2 + (x1 + 1.2 x2 + x3 - x4 -
0.1 x5)^2 + (1.2 x1 + x2 - x3 - 0.1 x4 + x5)^2 + (-x1 - 0.1 x2 + x3 +
1.2 x4 + x5)^2 + (x1 - x2 - 0.1 x3 + x4 + 1....
3
Probably not a serious answer, but we could use the built-in "ClosestPacking" method available in ImageCollage, which conveniently also has a padding option:
SeedRandom[0];
images=ConstantImage[RandomColor[],#]&/@RandomInteger[{30,60},{12,2}];
packing=ImageCollage[1->images,ImagePadding->2,Method->"ClosestPacking",Background-&...
2
One approach is to find the zero of
Reduce[D[q ((-Log[1 - q])^-a - (-Log[q])^-a)/a, q] == 0 && 0 < q < 1, q, Reals]
but it returns unevaluated, suggesting that there is no symbolic solution. In the absence of a symbolic solution, a numeric solution can be obtained quickly with,
Plot[NMaxValue[{(q ((-Log[1 - q])^-a - (-Log[q])^-a))/a, 0 < q ...
1
A faster option than the one in the comment
flushQ[hand_] := MatchQ[hand/100 // Floor, {___, x_, x_, x_, x_, x_, ___}]
Count[sortedHands, _?flushQ]/Length[sortedHands]
(* 20889/1059380 *)
Top 50 recent answers are included