Skip to main content
Bounty Ended with 50 reputation awarded by Vsevolod A.
Added alternative
Source Link
Michael E2
  • 244.8k
  • 18
  • 351
  • 774
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
 ]

enter image description here

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]
  ]
 ]
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
 ]

enter image description here

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. 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}}  *)
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}  pg],
 Graphics3D[{Red, Sphere[{x, y, FF[x, y]} /. Last@fm, 0.01]}],
 PlotRange -> All
 ]

enter image description here

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}  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}  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]
  ]
 ]
Added addendum
Source Link
Michael E2
  • 244.8k
  • 18
  • 351
  • 774

I suspect that the use of a region is calling a specializedan optimizer and the option value isoptions are not being passed (*see below). It should probably be reported to WRI as a potential bug to see what they say.

Here's anothera way: to enforce the constraint, by constructing one's own penalty function. We also use a second starting point so that FindMaximum will avoid using the derivative of FF, which is not smooth.

enter image description here


Addendum.

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. 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]
  ]
 ]

FindMinimum::cvmit: Failed to converge to the requested accuracy or precision within 1 iterations.
... [two more messages] ...
General::stop: Further output of FindMinimum::cvmit will be suppressed during this calculation.

FindMaximum::cvmit: Failed to converge to the requested accuracy or precision within 30 iterations.

(*  {0.200079, {x -> 0.794926, y -> -1.60892}} v *)

By reducing PrecisionGoal and AccuracyGoal, one can also reduce the number of iterations needed. Note the option values have to be set in both places:

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]
  ]
 ]

FindMinimum::eit: The algorithm does not converge to the tolerance of 0.01` in 30 iterations. The best estimated solution, with feasibility residual, KKT residual, or complementary residual of {2.7883410^-11,0.0152532,1.3941610^-11}, is returned.

(*  {0.200107, {x -> 0.790959, y -> -1.60642}}  *)

I suspect that the use of a region is calling a specialized optimizer and the option value is not being passed. It should probably be reported.

Here's another way:

enter image description here

I suspect that the use of a region is calling an optimizer and options are not being passed (*see below). It should probably be reported to WRI as a potential bug to see what they say.

Here's a way to enforce the constraint, by constructing one's own penalty function. We also use a second starting point so that FindMaximum will avoid using the derivative of FF, which is not smooth.

enter image description here


Addendum.

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. 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]
  ]
 ]

FindMinimum::cvmit: Failed to converge to the requested accuracy or precision within 1 iterations.
... [two more messages] ...
General::stop: Further output of FindMinimum::cvmit will be suppressed during this calculation.

FindMaximum::cvmit: Failed to converge to the requested accuracy or precision within 30 iterations.

(*  {0.200079, {x -> 0.794926, y -> -1.60892}} v *)

By reducing PrecisionGoal and AccuracyGoal, one can also reduce the number of iterations needed. Note the option values have to be set in both places:

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]
  ]
 ]

FindMinimum::eit: The algorithm does not converge to the tolerance of 0.01` in 30 iterations. The best estimated solution, with feasibility residual, KKT residual, or complementary residual of {2.7883410^-11,0.0152532,1.3941610^-11}, is returned.

(*  {0.200107, {x -> 0.790959, y -> -1.60642}}  *)
Source Link
Michael E2
  • 244.8k
  • 18
  • 351
  • 774

I suspect that the use of a region is calling a specialized optimizer and the option value is not being passed. It should probably be reported.

Here's another way:

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
 ]

enter image description here