dist[x_, y_] = RegionDistance[pg, {x, y}];
penalty[x_?NumericQ, y_?NumericQ] := Unitize[#] + # &@dist[x, y];
fm = FindMaximum[
FF[x, y] -
penalty[x, y], {{x, y}, RegionCentroid@pg, pg[[1, 1]]}\[Transpose],
MaxIterations -> 30]
(* {0.200105, {x -> 0.789665, y -> -1.60565}} *)
Show[
Plot3D[{FF[x, y], FF[x, y] - penalty[x, y]}, {x, y} \[Element]∈ pg],
Graphics3D[{Red, Sphere[{x, y, FF[x, y]} /. Last@fm, 0.01]}],
PlotRange -> All
]
Update: Another workaround
The discussion in the addendum below suggests using RegionMember
instead of Element
as a workaround:
FindMaximum[{FF[x, y],
RegionMember[pg, {x, y}]}, {{x, pg[[1, 1, 1]]}, {y, pg[[1, 1, 2]]}},
MaxIterations -> 2]
FindMaximum::cvmit: Failed to converge to the requested accuracy or precision within 2 iterations.
(* {0.195039, {x -> 0.742393, y -> -1.64621}} *)
With the option settings as follows, we get a result without error/warning messages:
FindMaximum[{FF[x, y], RegionMember[pg, {x, y}]},
{{x, pg[[1, 1, 1]]}, {y, pg[[1, 1, 2]]}},
PrecisionGoal -> 2, AccuracyGoal -> 2, MaxIterations -> 7]
(* {0.200033, {x -> 0.788627, y -> -1.60954}} *)
The following shows that FindMinimum
is called with the default setting for the options. For some reason, after FindMinimum
fails multiple times, FindMaximum
seems to be run. I'm pretty sure it's an internal function being run as a proxy, but it's curious. A Trace[]
show it is running FindMinimum
on -FF[x,y]
for two of the three line segments making up the triangle pg
and then on the polygon; it seems it skips one of the line since it didn't show up. It would be nice to eliminate what seem to be extraneous FindMinimum
runs, but they might be helping to narrow down a solution, I suppose. Someone with time to Trace[]
the computation might be able to shed more light.
With[{opts = Options@FindMinimum},
Internal`WithLocalSettings[
SetOptions[FindMinimum, MaxIterations -> 1],
ffm = FindMaximum[{FF[x, y], {x, y} \[Element]∈ pg}, {{x,
pg[[1, 1, 1]]}, {y, pg[[1, 1, 2]]}}, MaxIterations -> 30],
SetOptions[FindMinimum, opts]
]
]
With[{opts = Options@FindMinimum},
Internal`WithLocalSettings[
SetOptions[FindMinimum,
{PrecisionGoal -> 2, AccuracyGoal -> 2, MaxIterations -> 30}],
ffm = FindMaximum[{FF[x, y], {x, y} \[Element]∈ pg}, {{x,
pg[[1, 1, 1]]}, {y, pg[[1, 1, 2]]}},
PrecisionGoal -> 2, AccuracyGoal -> 1, MaxIterations -> 30],
SetOptions[FindMinimum, opts]
]
]
(* {0.200107, {x -> 0.790959, y -> -1.60642}} *)
Here is the tracing code:
With[{opts = Options@FindMinimum},
Internal`WithLocalSettings[
SetOptions[FindMinimum, MaxIterations -> 1],
Trace[
FindMaximum[{FF[x, y], {x, y} ∈ pg}, {{x,
pg[[1, 1, 1]]}, {y, pg[[1, 1, 2]]}}, MaxIterations -> 30],
_FindMinimum,
TraceInternal -> True],
SetOptions[FindMinimum, opts]
]
]