Given some $d \in \Bbb{Z}_{>0}$, $t \in [0,1]$, and $0 < a < b < 1$, fix $I = [a,b]$. I'm trying to compute
$$
\min_n \min_{E_n(t)} f_d(\mathbf{x})
$$
where $n \in \Bbb{Z}_{>0}$,
$$
f_d(\mathbf{x}) = \begin{cases}
d^2 \tan(\frac{\pi}{2} \, \mathbf{x}) + 8d & \text{if } \mathbf{x} \in I\\
\displaystyle f(x_1) + \sum_{k = 2}^n (1 - x_{k-1}) f(x_k, \dotsc, x_n) & \text{if } \mathbf{x} = (x_1, \dotsc, x_n) \in I^n
\end{cases}
$$
and $E_n(t) = \{\mathbf{x} \in I^n \mid g_n(\mathbf{x}) \geq t\}$ with
$$
g_n(\mathbf{x}) = 1 - \prod_{k = 1}^n (1 - x_k).
$$
My current setup is
Clear[ff, gf, cf, min]
{a, b} = {1/10, 95/100};
(*Target function*)
ff[n_?IntegerQ, d_?IntegerQ] :=
Fold[d^2*Tan[#2*Pi/2] + 8*d + (1 - #2) #1 &, 0,
Reverse[Array[x, n]]];
(*Constraints*)
gf[n_?IntegerQ] := (1 - Product[(1 - x[i]), {i, n}]);
cf[n_?IntegerQ, t_?NumericQ] :=
Join[{gf[n] >= t}, Table[a <= x[i] <= b, {i, n}]];
min[n_, d_, t_] := NMinimize[{ff[n, d], cf[n, t]}, Array[x, n]];
I thought that I could just run `NMinimize` on `min`, but it spits out a bunch of errors:
NMinimize[{First @ min[n, 25, 0.75], n \[Element] Integers, 100 >= n >= 1}, n]
(*
Array::ilsmn: Single or list of non-negative machine-sized integers expected at position 2 of Array[x,n]. >>
NMinimize::bcons: The following constraints are not valid: {cf[n,0.75]}. Constraints should be equalities, inequalities, or domain specifications involving the variables. >>
NMinimize::objfs: The objective function {ff[n,25],cf[n,0.75]} should be scalar-valued. >>
NMinimize[{{ff[n, 25], cf[n, 0.75]}, n \[Element] Integers, n >= 1},
n]
*)
I assume that this is because `First` is operating on the `FullForm` of `min` before the minimization algorithm gets to substitute something for `n` or, in other words, because `First @ min[n, 25, 0.75]` is evaluated eagerly. I tried wrapping this function in a `Function`, but that didn't work either, I assume because `NMinimize` works by symbol replacement instead of by function evaluation.
On the other hand, the brute-force approach seems to work, but it is very inefficient
MinimalBy[#, First] & @ Map[min[#, 25, 0.75] &, Range[20]] // Timing
(*{67.768000, {{1234.95, {x[1] -> 0.402552, x[2] -> 0.376923,
x[3] -> 0.32842}}}}*)
----------
Truth be told, pretty soon I noticed that $\min_{E_d(t)} f_d(\mathbf{x})$ starts as a decreasing function, reaches a rather small minimum, and then keeps increasing. My istinctive approach would have been something like
takeWhile2[#, Function[{prev, cur}, First[prev] > First[cur]]] & @
lazyMap[min[#, 25, 0.75]&, lazyRange[100]]
which sadly hinges on three functions which I don't know how (or if) can be implemented in Mathematica, namely
* `lazyRange[n]`: A lazy list containing the elements of `Range[n]`. This isn't strictly necessary in this example, but I would need it to remove the artificial bound $n \leq 100$.
* `lazyMap[f, expr]`: Just a lazy version of `Map[f, expr]`. This is where the main performance improvement would come from.
* `takeWhile2[list, crit]`: Just like `TakeWhile`, but with a binary criterion. It always gives the first element of `list` and then keeps giving elements as long as `crit` is `True` as a function of the last given element and of the current one.