0
$\begingroup$

I have a function that I am unable to recover a solution for. Here, 0.533... and 0.428... are the exact solutions for Rs[399] and Rp[399], given a known nn1 and k. I am using NMinimize to recover the solution nn1 and k originally used to calculate those exact values by minimizing the difference between the solution and the function itself (I have tested some direct solving methods, but none have worked as well). If the variables in NMinimize are constrained close enough to the known solutions, it can find the global minimum. However, I am aiming to apply this solving method to problems where it would be unrealistic to constrain quite that closely (more realistic constraints are shown in the code below). Is there any way to further increase the likelihood that NMinimize picks the global minimum? I have tried several different methods, but none I have tested have fixed the issue thus far.

Subscript[n, 1] = nn1 + (I*k)
NMinimize[{Abs[0.533600799853412 - Rs[399]], 
  0. == Abs[0.4285443166333881 - Rp[399]] && nn1 > 0.01 && 
   k > 0.01 && nn1 < 50 && k < 50}, {nn1, k}, 
 Method -> {"SimulatedAnnealing", "PerturbationScale" -> 20}, 
 AccuracyGoal -> 20, PrecisionGoal -> 20]

The correct solution would be nn1 = 3.392905674418965 and k = 2.411816858393506. Functions are shown below.

rs[\[Lambda]_] := 
   (E^((4*I*Pi*Subscript[d, 1]*
          Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
            Subscript[n, 1]^2])/\[Lambda])*
          (Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] + 
       Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
                 
         Subscript[n, 1]^2])*(Sqrt[(-Sin[\[Theta]]^2)*
          Subscript[n, 0]^2 + Subscript[n, 1]^2] - 
             
       Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
         Subscript[n, 2]^2]) + 
        (Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] - 
       Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
                 
         Subscript[n, 1]^2])*(Sqrt[(-Sin[\[Theta]]^2)*
          Subscript[n, 0]^2 + Subscript[n, 1]^2] + 
             
       Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
         Subscript[n, 2]^2]))/
     (E^((4*I*Pi*Subscript[d, 1]*
          Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
            Subscript[n, 1]^2])/\[Lambda])*
          (Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] - 
       Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
                 
         Subscript[n, 1]^2])*(Sqrt[(-Sin[\[Theta]]^2)*
          Subscript[n, 0]^2 + Subscript[n, 1]^2] - 
             
       Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
         Subscript[n, 2]^2]) + 
        (Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] + 
       Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
                 
         Subscript[n, 1]^2])*(Sqrt[(-Sin[\[Theta]]^2)*
          Subscript[n, 0]^2 + Subscript[n, 1]^2] + 
             
       Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + Subscript[n, 2]^2]))
Rs[\[Lambda]_] := rs[\[Lambda]]*Conjugate[rs[\[Lambda]]]
rp[\[Lambda]_] := 
   ((Cos[(2*Pi*Subscript[d, 1]*
           Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
             Subscript[n, 1]^2])/\[Lambda]] + 
             (I*Sec[\[Theta]]^2*
          Sin[(2*Pi*Subscript[d, 1]*
              Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
                             Subscript[n, 1]^2])/\[Lambda]]*
          Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2]*
                  
          Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
            Subscript[n, 1]^2])/Subscript[n, 1]^2)*
          Subscript[n, 2]^2 + 
        ((-Cos[(2*Pi*Subscript[d, 1]*
              Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
                Subscript[n, 1]^2])/
                      \[Lambda]])*Sec[\[Theta]]^2*
        Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] - 
             (I*
          Sin[(2*Pi*Subscript[d, 1]*
              Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
                Subscript[n, 1]^2])/
                      \[Lambda]]*Subscript[n, 1]^2)/
        Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
          Subscript[n, 1]^2])*
          
     Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + Subscript[n, 2]^2])/
     ((Cos[(2*Pi*Subscript[d, 1]*
           Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
             Subscript[n, 1]^2])/\[Lambda]] - 
             (I*Sec[\[Theta]]^2*
          Sin[(2*Pi*Subscript[d, 1]*
              Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
                             Subscript[n, 1]^2])/\[Lambda]]*
          Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2]*
                  
          
          Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
            Subscript[n, 1]^2])/Subscript[n, 1]^2)*
          Subscript[n, 2]^2 + 
        (Cos[(2*Pi*Subscript[d, 1]*
            Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
              Subscript[n, 1]^2])/\[Lambda]]*
               Sec[\[Theta]]^2*
        Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] - 
             (I*
          Sin[(2*Pi*Subscript[d, 1]*
              Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
                Subscript[n, 1]^2])/
                      \[Lambda]]*Subscript[n, 1]^2)/
        Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + 
          Subscript[n, 1]^2])*
          
     Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + Subscript[n, 2]^2])
Rp[\[Lambda]_] := rp[\[Lambda]]*Conjugate[rp[\[Lambda]]]

Variables are defined thus:

Subscript[n, 0] = 1;
Subscript[n, 2] = 1;
Subscript[d, 1] = 40;
\[Theta] = Pi/6;

Any input/suggestions are more than welcome! Thank you!

Improve this question
$\endgroup$
4
  • $\begingroup$ When posting code please convert cells to InputForm prior to copy and paste into MSE. $\endgroup$
    – Bob Hanlon
    Jun 29, 2021 at 21:48
  • $\begingroup$ @BobHanlon should be fixed, thanks! $\endgroup$
    – mollyk
    Jun 29, 2021 at 21:54
  • $\begingroup$ If you only want to vary nn1 and k you need to assign values to the other parameters {d1, n0, n2, θ}. $\endgroup$
    – Bob Hanlon
    Jun 30, 2021 at 1:05
  • $\begingroup$ @BobHanlon they were defined in my code, but I neglected to include here. They're added now! $\endgroup$
    – mollyk
    Jun 30, 2021 at 17:27

1 Answer 1

Reset to default
1
$\begingroup$ 
Clear["Global`*"]

Format[n[k_]] := Subscript[n, k]

Format[d[1]] := Subscript[d, 1]

rs[λ_] := (E^((4*I*Pi*d[1]*
          Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ)*(Sqrt[
        Cos[θ]^2*n[0]^2] + 
       Sqrt[(-Sin[θ]^2)*n[0]^2 + 
         n[1]^2])*(Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2] - 
       Sqrt[(-Sin[θ]^2)*n[0]^2 + n[2]^2]) + (Sqrt[
        Cos[θ]^2*n[0]^2] - 
       Sqrt[(-Sin[θ]^2)*n[0]^2 + 
         n[1]^2])*(Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2] + 
       Sqrt[(-Sin[θ]^2)*n[0]^2 + 
         n[2]^2]))/(E^((4*I*Pi*d[1]*
          Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ)*(Sqrt[
        Cos[θ]^2*n[0]^2] - 
       Sqrt[(-Sin[θ]^2)*n[0]^2 + 
         n[1]^2])*(Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2] - 
       Sqrt[(-Sin[θ]^2)*n[0]^2 + n[2]^2]) + (Sqrt[
        Cos[θ]^2*n[0]^2] + 
       Sqrt[(-Sin[θ]^2)*n[0]^2 + 
         n[1]^2])*(Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2] + 
       Sqrt[(-Sin[θ]^2)*n[0]^2 + n[2]^2]))

Rs[λ_] := rs[λ]*Conjugate[rs[λ]]

rp[λ_] := ((Cos[(2*Pi*d[1]*
           Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ] + (I*
          Sec[θ]^2*
          Sin[(2*Pi*d[1]*
              Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
          Sqrt[Cos[θ]^2*n[0]^2]*
          Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/n[1]^2)*
     n[2]^2 + ((-Cos[(2*Pi*d[1]*
              Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ])*
        Sec[θ]^2*
        Sqrt[
         Cos[θ]^2*n[0]^2] - (I*
          Sin[(2*Pi*d[1]*
              Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
          n[1]^2)/Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])*
     Sqrt[(-Sin[θ]^2)*n[0]^2 + 
       n[2]^2])/((Cos[(2*Pi*d[1]*
           Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ] - (I*
          Sec[θ]^2*
          Sin[(2*Pi*d[1]*
              Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
          Sqrt[Cos[θ]^2*n[0]^2]*
          Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/n[1]^2)*
     n[2]^2 + (Cos[(2*Pi*d[1]*
            Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
        Sec[θ]^2*
        Sqrt[
         Cos[θ]^2*n[0]^2] - (I*
          Sin[(2*Pi*d[1]*
              Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
          n[1]^2)/Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])*
     Sqrt[(-Sin[θ]^2)*n[0]^2 + n[2]^2])

Rp[λ_] := rp[λ]*Conjugate[rp[λ]]

n[0] = 1;
n[2] = 1;
d[1] = 40;
θ = Pi/6;

n[1] = nn1 + I*k;

Use Minimize. From the documentation, "If f and cons are linear or convex, the result given by NMinimize will be the global minimum, over both real and integer values; otherwise, the result may sometimes only be a local minimum."

Minimize[{Abs[0.533600799853412 - Rs[399]], 
  0 == Abs[0.4285443166333881 - Rp[399]], nn1 > 1/100, k > 1/100, 
  nn1 < 50, k < 50}, {nn1, k}]

(* {2.47942*10^-8, {nn1 -> 3.39292, k -> 2.41182}} *)
Improve this answer
$\endgroup$

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.