How should i write the code to minimize this function?

I am not a mathematica user. I need to find the solution to a given problem, which we already described there for theoretical analysis. I'll rewrite here the problem:

Let $$\mathbf a = (a_1,...,a_d)$$ is a constant in $$\mathbb R_{+}^d \setminus \{\mathbf 0\}$$ (some $$a_i$$ can be $$0$$ but not all, all are $$\ge 0$$).

Define the set $$S(\mathbf a) = \left\{\mathbf x \in \mathbb C^d:\; \sum_{i=1}^d \frac{x_i +1}{x_i -1}a_i = 1 \right\}.$$

Define the distance of the set to zero as :

$$d(\mathbf a) = \min\limits_{\mathbf x \in S(a)} \sum_{i=1}^d \lvert x_i \rvert$$

We found out that this distance is always greater than $$1$$, and I am wandering if there could be a simple function that computes it from $$\mathbf a$$.

When $$d = 1$$, we already solved the problem by hand.

If $$d=2$$ and for particular values of $$a_1,a_2$$, wolfram alpha finds a theoretical minimum with the following command:

Minimize[{Abs[x] + Abs[y], (3 (1 + x))/(-1 + x) + (2 (1 + y))/(-1 + y) == 1}, {x, y}]


wich produces the same output in a mathematica kernel.

How can i generalize this command to tell mathematica to find the function $$d(\mathbf a)$$ for me ? (let's say for a given dimension $$d$$, i can run it once for each dimension if needed). I want it to consider $$\mathbf a$$ as a nuisance parameter and give me a minimum that depends on $$\mathbf a$$.

• Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! Feb 5, 2021 at 20:33
• Okay, I guess it's easy enough to see that $d$ and $d$ are not the same thing, though it does add to the cognitive load when reading. The set $S$ is defined over the complexes and Minimize works over the reals. So do you want to minimize over the real or the complex numbers? I suppose Minimize accidentally works in the example, because the solution turns out to be real. Feb 5, 2021 at 20:38
• @MichaelE2 Yes you are right the double $d$ notation is a little confusing, my bad. And yes, $x_i$'s are complex numbers ! My Minimize code was not good, i know.
– lrnv
Feb 5, 2021 at 22:43

Here we use $$z$$ instead of $$x$$ to express the complex number.

It seems that when d=2 and the min attain, the $$z_1,z_2$$ should be a real.

d = 2;
r = 1;
reg = Annulus[{0, 0}, {0.1, r}, {0.01, π/2}];
{a[1], a[2]} = RandomPoint[reg];
result = NMinimize[{Sum[Sqrt[x[i]^2 + y[i]^2], {i, 1, d}],
Sum[(z[i] + 1)/(z[i] - 1) a[i] /. z[i] -> x[i] + I*y[i] // ReIm //
ComplexExpand, {i, 1, d}] == {1, 0}},
Riffle[Array[x, d], Array[y, d]],
Method -> "DifferentialEvolution"]
Graphics[{Circle[{0, 0}, r], Point[Array[a, d]],
Text["a", {a[1], a[2]}, {-1, -1}], Red,
Point[Table[{x[i], y[i]}, {i, 1, 2}] /. result[[2]]],
Text["z1", {x[1], y[1]} /. result[[2]], {1, 1}],
Text["z2", {x[2], y[2]} /. result[[2]], {1, 1}], EdgeForm[Green],
FaceForm[], reg}]


For $$d=4$$, we also use numeric method to test the solution.

Clear["Global*"];
d = 4;
r = 3;
reg = ImplicitRegion[
And @@ Thread[Array[a, d] > 0]  &&
Array[a, d] ∈ Ball[Array[0 &, d], r] // Evaluate,
Array[a, d] // Evaluate];
Evaluate[Array[a, d]] = RandomPoint[reg]
result = NMinimize[{Sum[Sqrt[x[i]^2 + y[i]^2], {i, 1, d}],
Sum[(z[i] + 1)/(z[i] - 1) a[i] /. z[i] -> x[i] + I*y[i] // ReIm //
ComplexExpand, {i, 1, d}] == {1, 0}},
Riffle[Array[x, d], Array[y, d]], Method -> "DifferentialEvolution"]


You can use Norm[_,1] as the objective function in Minimize:

ClearAll[minOneNorm]

minOneNorm[a_] := Module[{xx = Array[x, Length@a]},
Minimize[{Norm[xx, 1], a.((1 + xx)/(xx - 1)) == 1}, xx]]


Examples:

minOneNorm[{3}]

{2, {x[1] -> -2}}

minOneNorm[{3, 2}] // Simplify

{-(1/2) + Sqrt[6],
{x[1] -> 1/2 (-1 + Sqrt[6]), x[2] -> Sqrt[3/2]}}

minOneNorm[{3, 2, 1}] // Simplify

 {7/5,
{x[1] -> 0, x[2] -> 0, x[3] -> 7/5}}

sol = minOneNorm[{3, 2}] // Simplify;
argmin = {x[1], x[2]} /. sol[[2]]

 {1/2 (-1 + Sqrt[6]), Sqrt[3/2]}

minvalue = sol[[1]]

 -(1/2) + Sqrt[6]


We can use ContourPlot to show the locus of points where the objective function value is equal to minvalue and RegionPlot to show the locus of points that satisfy the constraint (representing the constraint as an ImplicitRegion):

ClearAll[impReg]
impReg[a_] := With[{xx = Array[x, Length @ a]},
ImplicitRegion[{a.((1 + xx)/(xx - 1)) == 1}, xx]]

Show[ContourPlot[Norm[{x, y}, 1] == minvalue, {x, -4, 4}, {y, -6, 2},
ContourStyle -> Directive[Thick, Blue],
Epilog -> {PointSize[Large], Green, Point[argmin]}],
RegionPlot[impReg[{3, 2}], BoundaryStyle -> Directive[Thick, Red]]]


• Why use ImplicitRegion instead of the equation a.((1 + xx)/(xx - 1)) == 1? Feb 5, 2021 at 20:48
• @MichaelE2, why indeed! Thank you. Updated with the simpler formulation. (I had started with ImplicitRegion to picture the feasible set; continued on that trajectory:)
– kglr
Feb 5, 2021 at 20:54
• The other thing, if it's not a typo in the OP, is that x ranges over the complex numbers, which would require another refactoring. I left a comment under the question asking for clarification. Feb 5, 2021 at 21:02
• This is something. Thanks a lot for the point-wise solution in the first part of the code. On the second half, i did not understand what it does (since i do not speak mathematica, only c++ and english lol): What is the equation of the red curve on the graph ? and the green point ? Btw, does it run over complex numbers or only integers ? Last edit: Would it work with @Daniel Huber's NMinimize call ?
– lrnv
Feb 5, 2021 at 22:42
• @lrnv, red curve is the locus of points that satisfy the constraint. The green point is the minimizer. You can replace Minimize with NMinimize (but remember that Minimize finds a global minimum, whereas NMinimize might get stuck at a local minimum.)
– kglr
Feb 5, 2021 at 23:09

For larger dimensions Minimize may take unreasonably long. NMinimize may be more appropriate. In the following I ignore the case where a={0,0,..} as this is easily spotted and complicates things.

To make things tidy, we first create functions for the needed variables and the equations:

sum[a_] := Sum[
a[[i]] (Subscript[x, i] + 1)/(Subscript[x, i] - 1), {i, Length[a]}];
vars[a_] := Table[Subscript[x, i], {i, Length[a]}];


An example for dimension=3:

a = {1, 2, 3};
Minimize[{Norm[vars[a],1], sum[a] == 1, vars[a] >= 0}, vars[a]]


• Should'nt it be Norm[vars[a],1]` instead?
– lrnv
Feb 5, 2021 at 22:47
• You are right, thank you. I made the correction. Feb 6, 2021 at 9:49