PLOT в Mathematica с использованием NArgMax против FindArgMax

Question

У меня были некоторые проблемы с использованием Plot для построения графиков сложной составной функции.

Я пытаюсь построить ArgMax составной функции F[].

F[] включает несколько уровней вложенных составных функций, многие из которых включают Solve[] и Min[] или Max[].

У меня нет проблем с тем, как F[] выполняет в моей программе (с возможным исключением того, как она отображается в Plot), поэтому я не буду включать длинный код, который определяет F[] и его более простые функции , пока.

Когда я пытаюсь использовать

Plot[FindArgMax[F[],{vars}], я получаю очень быстрый возврат на мой вывод, что в основном правильно, за исключением того факта, что я получаю диапазон с некоторыми ошибочными ложными значениями, которые выглядят как неправильные вертикальные сегменты на части сюжет.

Я оценил F[] в диапазоне, в котором происходит глючение, и подтвердил, что правильные значения соответствуют гладкой кривой, показанной на втором рисунке ниже.

Plot[NArgMax[[F[],{vars}], я получаю правильный график, который не включает в себя сегменты с ошибками / ложными вертикальными сегментами, но занимает значительно больше времени.

Я не могу опубликовать вторую ссылку, но график NArgMax создает ту же картинку, что и выше, но гладкую, без отверстий и вертикальных сегментов.

Не вдаваясь в подробности F[], есть ли быстрый и простой способ убедить FindArgMax в правильной работе здесь? По сути, это общая проблема с Plot, которая хорошо известна, или мне нужно больше времени уделять перекодированию моих определений F[] и базовых составных функций, если я хочу использовать быструю команду FindArgMax в мой участок?

Заранее спасибо за любую помощь, с первого таймера здесь на форуме. :)

РЕДАКТИРОВАТЬ: Пример кода из проблемной части моей программы:

 a = 3000; b = 1/10; cc = 1/10; d = 1;</p>

<p>G1[x_, y_] := a Log[b x + cc  y + d]</p>

<p>Gx1[x_, y_] := Derivative[1, 0][G1][x, y];
Gy1[x_, y_] := Derivative[0, 1][G1][x, y];</p>

<p>piPP1 = {y, x};</p>

<p>c1ycrit0[fy_, mu1_] := 
 Max[0, Flatten[
     Solve[Gy1[x, y] == fy mu1 && piPP1[<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>] == piPP1[[2]], y, 
      x]][<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>][[2]]]</p>

<p>c1xcrit1[fx_, fy_, mu1_] := Max[Quiet[
   Flatten[
      Solve[Gx1[x, 
         Flatten[Solve[piPP1[<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>] == piPP1[[2]], y]][<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>][[2]]] == 
        mu1 fx, x]][<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>][[2]]], 
  Quiet[Flatten[
      Solve[Gx1[x, 
         Max[0, Flatten[
             Solve[Gy1[x, y] == fy*mu1 && piPP1[<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>] == piPP1[[2]], y,
               x]][<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>][[2]]]] == mu1 fx, x]]][<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>][[2]]]</p>

<p>c1xcrit2[fx_, fy_, mu1_, T1_] := 
 Max[Quiet[
   Flatten[Solve[T1 == x fx + fy c1ycrit0[fy, mu1] , x, 
       y]][<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>][[2]]], 
  Quiet[Flatten[
      Solve[{piPP1[<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>] == piPP1[[2]], T1 == x fx + fy piPP1[[2]]}, x,
        y]][<a href="https://i.stack.imgur.com/vnUsQ.gif" rel="nofollow noreferrer">1</a>][[2]]]]</p>

<p>Manipulate[
 Quiet[Plot[(fx - xc) Max[0, 
     Min[c1xcrit1[fx, fy, mu1], c1xcrit2[fx, fy, mu1, T1]]], {fx, 0, 
    fxMax}, PlotRange -> {{0, fxMax}, {0, xPTmax}}]],
 {{mu1, 10, Subscript[Mu, 1]}, 0, 100}, {{xc, 3}, 0, 
  100}, {{fy, 10}, 0, 100}, {{T1, 100}, 0, 1000}, {{fxMax, 50}, 0, 
  100}, {{xPTmax, 100}, 0, 400}, ContinuousAction -> None]</p>

<p>BRX[fy_, xc_, mu1_, T1_] := 
 Quiet[FindArgMax[(fx - 
      xc) (Min[{c1xcrit1[fx, fy, mu1], 
       c1xcrit2[fx, fy, mu1, T1]}]), {fx, xc}]]</p>

<p>BRX1[fy_, xc_, mu1_, T1_] := 
 Quiet[NArgMax[(fx - 
      xc) (Min[{c1xcrit1[fx, fy, mu1], c1xcrit2[fx, fy, mu1, T1]}]), 
   fx]]</p>

<p>Manipulate[
 xBR = Plot[BRX[fy, xc, mu1, T1], {fy, 0, hmax}, 
   PlotRange -> {{0, hmax}, {0, hmax}}], {{mu1, 10, 
   Subscript[Mu, 1]}, 0, 100}, {{xc, 3}, 0, 10}, {{T1, 100}, 0, 
  1000}, {{hmax, 40}, 0, 100}, ContinuousAction -> None]</p>

<p>Manipulate[
 xBR1 = Plot[BRX1[fy, xc, mu1, T1], {fy, 0, hmax}, 
   PlotRange -> {{0, hmax}, {0, hmax}}], {{mu1, 10, 
   Subscript[Mu, 1]}, 0, 100}, {{xc, 3}, 0, 10}, {{T1, 100}, 0, 
  1000}, {{hmax, 40}, 0, 100}, ContinuousAction -> None]

Дальнейшее редактирование: изменение начальной точки "xc" для решения для "fx" в функции BRX [] радикально меняет результат графика, что заставляет меня думать, что вряд ли я смогу с пользой использовать FindArgMax вообще. Я полагаю, что производные все слишком чокнутые из-за всех MIN и MAX в базовых функциях. Я все еще надеюсь, что здесь есть исправление, которое позволит использовать FindArgMax, но я гораздо менее оптимистичен после того, как попробовал некоторые из предложенных вещей.

Еще раз спасибо всем за вашу помощь! :)

Answer 1

Соответствующий ответ (см. Оригинал ниже)

Глядя на ваш код, проблема действительно в понимании отложенной / немедленной оценки в Mathematica. Например, понаблюдайте за тем, как хорошо выглядит следующее рендеринг по сравнению с вашим первым Manipulate.

Manipulate[
 Plot[Evaluate[(fx - xc) Max[0, 
     Min[c1xcrit1[fx, fy, mu1], c1xcrit2[fx, fy, mu1, T1]]]], {fx, 0, 
   fxMax}, PlotRange -> {{0, fxMax}, {0, xPTmax}}], {{mu1, 10, 
   Subscript[Mu, 1]}, 0, 100}, {{xc, 3}, 0, 100}, {{fy, 10}, 0, 
  100}, {{T1, 100}, 0, 1000}, {{fxMax, 50}, 0, 100}, {{xPTmax, 100}, 
  0, 400}]

Как видите, единственное отличие - это Evaluate, который оценивает выражение, которое будет нанесено на график раз и навсегда, вместо того, чтобы выполнять всю символическую математику каждый раз, когда требуется новый график. Я подозреваю, что добавление Evaluate аналогично другим графикам поможет вам, как только вы исправите свои ошибки.

Если вы хотите узнать, как вы должны были закодировать вышеперечисленное, вот несколько пунктов для изучения:

• Узнайте о Rule (->) и ReplaceAll (./): вместо того, чтобы сказать Flatten[{{y->x+2}}[[1]][[2]], вы должны использовать y/.First[{{y-> x+2}}].
• Бросить Quiet. Все они. Сейчас! ;) На самом деле - если вы не совсем уверены в том, что делаете, Quiet просто будет скрывать ваши ошибки от вас.
• Узнайте о Set (=) против SetDelayed (:=). В качестве примера, смотрите ниже, как я бы реализовал ваш c1xcrit1: использование = вместо := означает, что вся символьная математика выполняется один раз, когда x1xcrit1 определен , а не каждый раз, когда это оценены.

Надеюсь, это немного поможет - но на самом деле, если вы хотите использовать Mathematica, вы должны найти учебник или что-то, чтобы научить вас основам.

c1xcrit1[fx_, fy_, mu1_] = With[{
   y1 = y /. First@Solve[piPP1[[1]] == piPP1[[2]], y], 
   y2 = y /. First@Solve[Gy1[x, y] == fy*mu1 && piPP1[[1]] == piPP1[[2]], y, x]
   },Max[
     x /. First@Solve[Gx1[x, y1] == mu1 fx, x], 
     x /. First@Solve[Gx1[x, y2] == mu1 fx, x]]]

Оригинальный ответ

Две сравниваемые функции используют очень разные алгоритмы: FindArgMax - это удобный интерфейс для FindMaximum, а NArgMax - для NMaximize. Сравнение методов, доступных для двух функций

• FindMaximum / FindArgMax: ConjugateGradient, PrincipalAxis, LevenbergMarquardt, Newton и QuasiNewton (все дифференциальные методы),
• NArgMax / NMaximize: NelderMead, DifferentialEvolution, SimulatedAnnealing и RandomSearch (все точечные методы).

Другими словами: используйте FindMaximum или FindArgMax для хороших функций, где производные дают полезную информацию. Для неприятной функции используйте NArgMax / NMaximize.

Поскольку FindArgMax почти работает, я предполагаю, что ваша функция хороша. Для дифференциальных методов эволюция сначала выполняется символически в попытке установить аналитическое выражение для градиента. Цитата из документа: «FindArgMax сначала локализует значения всех переменных, затем оценивает f с символическими переменными, а затем повторно оценивает результат численно».

Звучит так, будто ваш F достаточно сложен, и символическая оценка никуда не денется. Если это так, тогда не допускайте символьных вычислений путем переноса. Кроме того, добавление кэша в то же время редко причиняет боль:

Fnum[args__/;And@@(NumericQ/@{args})]:=Fnum[args]=F[args]

Вы можете подумать, что это будет так же медленно, как и NArgMax, но во многих случаях вы обнаружите, что алгоритмы QuasiNewton впечатляюще хороши при построении оценки производных, которые ему необходимы.

Учитывая, что мы не знаем ваш F, это, конечно, полная догадка - но я надеюсь, что это немного поможет.