Как минимизировать функцию с ограничениями в Mathematica - PullRequest
Новая
       28

Как минимизировать функцию с ограничениями в Mathematica

0 голосов
/ 11 апреля 2019

Я хочу свернуть следующую функцию: 

Ef[J2_, D2_, θA1_, θC1_, \[Phi]A1_, \[Phi]C1_] := 
  J2 (Sin[θA1] Sin[θC1] (Cos[\[Phi]A1] Cos[\[Phi]C1] + 
         Sin[\[Phi]A1] Sin[\[Phi]C1]) + Cos[θA1] Cos[θC1]) - 
   D2 (Sin[θA1] Cos[\[Phi]A1] Cos[θC1] - 
      Cos[θA1] Sin[θC1] Cos[\[Phi]C1]);

скажем, J2=0.1;D2=0.1;, где 0 <= theta <= pi и 0 <= phi <= 2 pi Я пытался </p> 

Minimize[{Ef[J2, D2, θA1, θC1, \[Phi]A1, \[Phi]C1], 
{θA1 \[Epsilon][0, π], θC1 \[Epsilon][0, π], \[Phi]A1 \[Epsilon][0, 2 π], \[Phi]C1 \[Epsilon][0, 2 π], }}, {θA1, θC1, \[Phi]A1, \[Phi]C1}]

но я получил перепечатку ввода ...

Есть предложения?

Спасибо, M

1 Ответ

1 голос
/ 11 апреля 2019

Я собираюсь попробовать другой подход и посмотреть, может ли оно найти решение 

Ef[J2_, D2_, θA1_, θC1_, φA1_, φC1_] :=  J2 (Sin[θA1] Sin[θC1]*
  (Cos[φA1] Cos[φC1] + Sin[φA1] Sin[φC1]) + Cos[θA1] Cos[θC1]) -
  D2 (Sin[θA1] Cos[φA1] Cos[θC1] - Cos[θA1] Sin[θC1] Cos[φC1]);
J2=1/10;D2=1/10;
NMinimize[{Ef[J2, D2, θA1, θC1, φA1, φC1], 0<=θA1<=Pi&&0<=θC1<=Pi&&
  0<=φA1<=2 Pi&&0<=φC1<=2 Pi}, {θA1, θC1, φA1, φC1},WorkingPrecision->32]

, которое мгновенно дает мне 

{-0.1414213562373095048801688724209560058569711627807200358098`32., 
 {θA1 -> 1.3609367058891979125401402005460735210021598955174397243367`32., 
  θC1 -> 2.5660541110980434566496343521125515860033321979399030055079`32., 
  φA1 -> 3.1415926535897927498306628362843651999778557816889010918926`32., 
  φC1 -> 6.2831853071795854493988148705854136770428612595496860217646`32.}}

Я заметил, что φA1 почтиконечно Пи и φC1 почти наверняка 2 Пи, поэтому 

s=Simplify[Ef[J2, D2, θA1, θC1, φA1, φC1]/.{φA1->Pi,φC1->2 Pi}]

дает 

(Cos[θA1 + θC1] + Sin[θA1 + θC1])/10

И теперь я пытаюсь найти решение 

FullSimplify[Minimize[{s, 0<=θA1<=Pi&&0<=θC1<=Pi}, {θA1, θC1}]]

, дающее 

{-1/(5*Sqrt[2]), {θA1 -> Pi, θC1 -> Pi/4}}

Проверяйте это внимательно, чтобы убедиться в отсутствии ошибок.

Посмотрите, сколько локальных минимумов -Sqrt [2] / 10 и которые удовлетворяют вашим ограничениям, найдут 

Length[Select[Partition[Flatten[Table[
  {Ef[J2, D2, θA1, θC1, φA1, φC1], θA1, θC1, φA1, φC1},
  {θA1,0,Pi,Pi/4},{θC1,0,Pi,Pi/4},{φA1,0,2Pi,Pi/64},{φC1,0,2 Pi,Pi/64}]],
  5],#[[1]]==-Sqrt[2]/10&]]

и может быть больше.

...