2
$\begingroup$

I have differential equations f11, f12, f21, and f22 with respect to t with parameters A and B. I've defined and solved these equations using NDSolve in Mathematica as follows:

A = 2;
B = 6;
NDSolve[
{f11'[t] == -(1/2) I A f12[t] + 1/2 I A f21[t], 
  f12'[t] == -(1/2) I A f11[t] - I B f12[t] + 1/2 I A f22[t], 
  f21'[t] == 1/2 I A f11[t] + I B f21[t] - 1/2 I A f22[t], 
  f22'[t] == 1/2 I A f12[t] - 1/2 I A f21[t], 
  f22[0] == 0,f11[0] == 1, f12[0] == 0, f21[0] == 0}, 
{f11[t], f12[t], f21[t], f22[t]}, {t, 0, 1}]

Plotting the solution for f22[t] produces a graph :

enter image description here

I want to adjust the parameters A and B to maximize the value of f22[t]. I just want the maximum value that f22[t] can achieve in any t. In this example, there will be several solutions available, I am interested in understand how I can approach the problem in Mathematica using this example.

Can you advise how to optimize A, B (and t) to achieve this maximum? I'm open to using numerical optimization methods or machine learning algorithms if necessary. Any guidance would be much appreciated.

$\endgroup$

2 Answers 2

5
$\begingroup$

You could use ParametricNDSolve with A and B as parameters and then use NArgMax. I use the range of t=0 to 1 for my range for ParametricNDSolve and NArgMax and I don't specify any restrictions on the domain of A and B

tMin = 0;
tMax = 1;
soln = f22[t] /. 
  ParametricNDSolve[{f11'[t] == -(1/2) I A f12[t] + 1/2 I A f21[t], 
    f12'[t] == -(1/2) I A f11[t] - I B f12[t] + 1/2 I A f22[t], 
    f21'[t] == 1/2 I A f11[t] + I B f21[t] - 1/2 I A f22[t], 
    f22'[t] == 1/2 I A f12[t] - 1/2 I A f21[t], f22[0] == 0, 
    f11[0] == 1, f12[0] == 0, f21[0] == 0}, {f22[t]}, {t, tMin, 
    tMax}, {A, B}]
NArgMax[{soln[A, B], tMin < t < tMax}, {A, B, t}]
(*{3.62302, 2.92786*10^-7, 0.867124}*)
$\endgroup$
1
  • $\begingroup$ Thank you so much! $\endgroup$
    – Saesun Kim
    Jun 20 at 18:43
3
$\begingroup$
Clear["Global`*"]

eqns = {f11'[t] == -(1/2) I A f12[t] + 1/2 I A f21[t], 
   f12'[t] == -(1/2) I A f11[t] - I B f12[t] + 1/2 I A f22[t], 
   f21'[t] == 1/2 I A f11[t] + I B f21[t] - 1/2 I A f22[t], 
   f22'[t] == 1/2 I A f12[t] - 1/2 I A f21[t], f22[0] == 0, f11[0] == 1, 
   f12[0] == 0, f21[0] == 0};

The equations can be solved exactly with DSolve for arbitrary A and B

sol = DSolve[eqns, {f11, f12, f21, f22}, t]

enter image description here

Verifying the solutions,

eqns /. sol[[1]] // Simplify

(* {True, True, True, True, True, True, True, True} *)

funcs = {f11[t], f12[t], f21[t], f22[t]} /. sol[[1]] // FullSimplify

(* {(A^2 + 2 B^2 + A^2 Cos[Sqrt[A^2 + B^2] t])/(
 2 (A^2 + B^2)), -((
  A (B - B Cos[Sqrt[A^2 + B^2] t] + 
     I Sqrt[A^2 + B^2] Sin[Sqrt[A^2 + B^2] t]))/(2 (A^2 + B^2))), (
 A (-B + B Cos[Sqrt[A^2 + B^2] t] + 
    I Sqrt[A^2 + B^2] Sin[Sqrt[A^2 + B^2] t]))/(2 (A^2 + B^2)), (
 A^2 Sin[1/2 Sqrt[A^2 + B^2] t]^2)/(A^2 + B^2)} *)

funcs[[4]] // InputForm

(* (A^2*Sin[(Sqrt[A^2 + B^2]*t)/2]^2)/(A^2 + B^2) *)

For simplicity, assume that A and B are positive. Then to restrict the argument of the Sin to the interval {0, Pi}

Assuming[A > 0 && B > 0, 
 Reduce[{0 <= (Sqrt[A^2 + B^2]*t)/2 <= Pi, A > 0, B > 0}, t, Reals] //
  Simplify]

(* 0 <= t <= (2 π)/Sqrt[A^2 + B^2] *)

{max, arg} = (NMaximize[
     {funcs[[4]], 0 <= t <= 2 Pi /Sqrt[A^2 + B^2], A > 0, B > 0},
     {t, A, B}, WorkingPrecision -> 15] // Rationalize[#, 0] &) /. 
  r_Rational :> N[r]

(* {1, {t -> 1.82578, A -> 1.72068, B -> 0}} *)

funcs[[4]] /. arg

(* 1. *)
$\endgroup$
1
  • $\begingroup$ Thank you so much. This definitely work, but for my application, I have actually much more complicated system, so I want to approach with numerical method. However, thank you so much! $\endgroup$
    – Saesun Kim
    Jun 20 at 18:40

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.