1
$\begingroup$

I have a complicated 4-vector, whose elements are trigonometric complex functions. I want to create 3D plots of the real and imaginary parts of each element. Additionally, I would like to evaluate the real and imaginary parts, compile the results into a table, and export them to a CSV file.

However, I'm facing issues in specific regions:

  1. For x1 <= 1 rad (below 50 degrees), the functions are not smooth

  2. around P1/2, the functions become indeterminate

I am aware of a boundary condition: normEvec3[0, y1_] = 0. I believe this condition could be useful in resolving the evaluation issues, but I am unsure how to effectively implement it in a way that benefits my solution.

As an example, below I show the plot of the real part of the first matrix element normEvec3[x1_, y1_] . The definition of normEvec3[x1_, y1_] is also provided.

Could you provide guidance on how to handle these problematic regions while plotting and exporting the data in Mathematica? Specifically, I'm looking for ways to manage the indeterminate behaviour and lack of smoothness in those regions.

The plot you see below was generated using the following script:

normEvec3[x1_, 
   y1_] = -Re[(23629 - 11900 Cos[3 x1] + 5036 Cos[4 x1] - 
       1684 Cos[5 x1] + 412 Cos[6 x1] - 
       304 Sqrt[2] Sqrt[
         2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
          278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] + 
       55 Sqrt[2] Cos[3 x1] Sqrt[
         2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
          278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] - 
       16 Sqrt[2] Cos[4 x1] Sqrt[
         2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
          278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] + 
       3 Sqrt[2] Cos[5 x1] Sqrt[
         2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
          278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] - 
       4 Cos[2 x1] (-6041 + 
          48 Sqrt[2] Sqrt[
            2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
             278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]]) + 
       2 Cos[x1] (-15698 + 
          99 Sqrt[2] Sqrt[
            2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
             278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]]) - 
       76 Cos[7 x1] + 
       7 Cos[8 x1])/(\[Sqrt](1 + 
          
          Abs[((23629 - 11900 Cos[3 x1] + 5036 Cos[4 x1] - 
                 1684 Cos[5 x1] + 412 Cos[6 x1] - 
                 304 Sqrt[2] Sqrt[
                   2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]] + 
                 55 Sqrt[2] Cos[3 x1] Sqrt[
                   2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]] - 
                 16 Sqrt[2] Cos[4 x1] Sqrt[
                   2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]] + 
                 3 Sqrt[2] Cos[5 x1] Sqrt[
                   2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]] - 
                 4 Cos[2 x1] (-6041 + 
                    48 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]]) + 
                 2 Cos[x1] (-15698 + 
                    99 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]]) - 76 Cos[7 x1] + 
                 7 Cos[8 x1]) (Cos[2 y1] + I Sin[2 y1]))/((-40 + 
                 14 Cos[x1] - 8 Cos[2 x1] + 2 Cos[3 x1] + 
                 Sqrt[2] Sqrt[
                   2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]]) (-180 + 148 Cos[x1] + 
                 42 Cos[3 x1] - 12 Cos[4 x1] + 2 Cos[5 x1] + 
                 3 Sqrt[2] Sqrt[
                   2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]] + 
                 Cos[2 x1] (-128 + 
                    Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]])))]^2 + 
          1/16 Abs[((2158 - 864 Cos[3 x1] + 274 Cos[4 x1] - 
                  64 Cos[5 x1] + 7 Cos[6 x1] - 
                  28 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]] + 
                  3 Sqrt[2] Cos[3 x1] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]] + 
                  Cos[2 x1] (1913 - 
                    12 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]]) + 
                  7 Cos[x1] (-416 + 
                    3 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]])) Tan[x1/2]^2)/((-2 + 
                  Cos[x1]) (-180 + 148 Cos[x1] + 42 Cos[3 x1] - 
                  12 Cos[4 x1] + 2 Cos[5 x1] + 
                  3 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]] + 
                  Cos[2 x1] (-128 + 
                    Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]])))]^2 + 
          Abs[((-56 + 42 Cos[x1] - 24 Cos[2 x1] + 6 Cos[3 x1] + 
                 Sqrt[2] Sqrt[
                   2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]]) (Cos[2 y1] + I Sin[2 y1]) Tan[
                 x1/2]^2)/(-40 + 14 Cos[x1] - 8 Cos[2 x1] + 
               2 Cos[3 x1] + 
               Sqrt[2] Sqrt[
                 2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                  888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                  5 Cos[6 x1]])]^2) (-40 + 14 Cos[x1] - 8 Cos[2 x1] + 
         2 Cos[3 x1] + 
         Sqrt[2] Sqrt[
           2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
            278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]]) (-180 + 
         148 Cos[x1] + 42 Cos[3 x1] - 12 Cos[4 x1] + 2 Cos[5 x1] + 
         3 Sqrt[2] Sqrt[
           2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
            278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] + 
         Cos[2 x1] (-128 + 
            Sqrt[2] Sqrt[
              2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
               278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]])) (Cos[
           y1] - I Sin[y1])^2)];

reVect31low = 
  Plot3D[If[x1 <= 5, 0, normEvec3[x1 Degree, y1 Degree]], {x1, 0, 
    88.0}, {y1, 0, 360}, ColorFunction -> Hue, ImageSize -> 500, 
   PlotRange -> {{0, 180}, {0, 360}, {-1.0, 1.0}}, PlotPoints -> 80];
reVect31high = 
  Plot3D[normEvec3[x1 Degree, y1 Degree], {x1, 91.0, 178}, {y1, 0, 
    360}, ColorFunction -> Hue, ImageSize -> 400, 
   PlotRange -> {{0, 180}, {0, 360}, {-1.0, 1.0}}, PlotPoints -> 80];
reVect31 = Show[reVect31low, reVect31high]

enter image description here

Improve this question
$\endgroup$
5
  • $\begingroup$ The code does not seem to reproduce the posted image. $\endgroup$
    – azerbajdzan
    Commented Sep 20 at 22:34
  • $\begingroup$ Hi @azerbajdzan! It works for me. In any case, I have uploaded the code again the way it worked for me. Please try it again. It does take about 30 seconds for the code to finish. Cheers $\endgroup$
    – Quantum Kid
    Commented Sep 20 at 22:40
  • $\begingroup$ I have found a solution to my problem. (See above for more info.) $\endgroup$
    – Quantum Kid
    Commented Sep 21 at 5:13
  • $\begingroup$ How was normEvec3 created? I think it should have been simplified during the process of creation. $\endgroup$
    – azerbajdzan
    Commented Sep 21 at 16:10
  • $\begingroup$ @azerbajdzan I hope that is true: normEvec3 is one of the normalized an eigenvectors of matrixB given in the following post. mathematica.stackexchange.com/questions/306761/… $\endgroup$
    – Quantum Kid
    Commented Sep 21 at 17:33

3 Answers 3

Reset to default
1
$\begingroup$

As I wrote in a comment below OP's question - the extremely long expression of normEvec3 can be simplified. In fact the simplified expression does not even need Re and Abs.

My simplified version normvec can be evaluated at x=0 or x=Pi/2 without problem. Also there are no problems in evaluating values close to x=Pi.

Exactly at x=Pi a limit can be used.

Limit[normvec, x -> Pi]

$\large{-\frac{\cos (2 y)}{\sqrt{2}}}$

r = 1/(256 (-2 + Cos[x])^2) (-24 + 78 Cos[x] - 24 Cos[2 x] + 
     2 Cos[3 x] + 
     Sqrt[2] \[Sqrt](2154 - 2896 Cos[x] + 1915 Cos[2 x] - 
         888 Cos[3 x] + 278 Cos[4 x] - 56 Cos[5 x] + 
         5 Cos[6 x]))^2 Csc[x]^4;
normvec = -Cos[2 y]/Sqrt[2]/Sqrt[1 + r];

Plot3D[normvec /. {x -> x Degree, y -> y Degree} // Evaluate, {x, 0, 
  180}, {y, 0, 360}, ColorFunction -> Hue, ImageSize -> 500, 
 PlotRange -> {{0, 180}, {0, 360}, {-1.0, 1.0}}, 
 WorkingPrecision -> 20, PlotPoints -> 100]

enter image description here

Here is the plot for x in the range 0, 360. Option Exclusions -> None was added to tell Mathematica that the function is continuous even at x=Pi and that no exclusion should take place in the region.

Plot3D[normvec /. {x -> x Degree, y -> y Degree} // Evaluate, {x, 0, 
  360}, {y, 0, 360}, ColorFunction -> Hue, ImageSize -> 500, 
 PlotRange -> {{0, 360}, {0, 360}, {-1.0, 1.0}}, 
 WorkingPrecision -> 20, PlotPoints -> 100, Exclusions -> None]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ You're amazing @azerbajdzan! Thank you, but how did you do it? I mean, I did try to simplify normEvec3 further using the Simplify and FullSimplify Mathematica functions, but the result you see for normEvec3 was the best I could get. Admittedly, I did abort the FullSimplify attempt as it was taking too long. Was I not patient enough? So my question is how did you manage to achieve the simplification of normEvec3 to normvec? Many thanks. $\endgroup$
    – Quantum Kid
    Commented Sep 22 at 14:48
  • 1
    $\begingroup$ @QuantumKid I guess you used Normalize but I did the normalization in two steps. First I computed Norm and simplified it. I simplified also the term of the vector and then divided it by norm. Then simplified again the result. I also tried to avoid using Abs, Re or Im in formulas. So if Mathematica outputted some formula with Abs[x] I replaced it with Sqrt[x^2]. Since we know x and y are reals it was possible to replace all Abs and Re. So the process was done by Mathematica but with a lot of manual helping.... and quite time consuming. $\endgroup$
    – azerbajdzan
    Commented Sep 22 at 15:05
  • $\begingroup$ Yes I did use Normalize. For some weird reason when I applied the FullSimplify function again to the whole 4 vector I got a much simpler result now, which I provide above. Without applying the normalization, the first element (normEvec3) that I was focusing one reduces to just -e^2iy! I don't know why I did not get this in my previous attempts at simplifying. $\endgroup$
    – Quantum Kid
    Commented Sep 22 at 15:22
1
$\begingroup$

UPDATE

With the help of ChatGPT, I was able to come up with a solution to correct the problematic regions of my function. The figure on the left is the "before" plot and the plot on the right is the "after" plot.

enter image description here

It is not perfect in the sense that I had to quiet some error messages (if someone can figure out how to fix them that would be great.) Below is the improved code that comes with annotations.

(*Define normEvec3*)
normEvec3[x1_, 
   y1_] := -Re[(23629 - 11900 Cos[3 x1] + 5036 Cos[4 x1] - 
       1684 Cos[5 x1] + 412 Cos[6 x1] - 
       304 Sqrt[2] Sqrt[
        2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
         278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] + 
       55 Sqrt[2] Cos[3 x1] Sqrt[
        2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
         278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] - 
       16 Sqrt[2] Cos[4 x1] Sqrt[
        2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
         278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] + 
       3 Sqrt[2] Cos[5 x1] Sqrt[
        2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
         278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] - 
       4 Cos[2 x1] (-6041 + 
          48 Sqrt[2] Sqrt[
           2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
            278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]]) + 
       2 Cos[x1] (-15698 + 
          99 Sqrt[2] Sqrt[
           2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
            278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]]) - 
       76 Cos[7 x1] + 
       7 Cos[8 x1])/(\[Sqrt](1 + 
          Abs[((23629 - 11900 Cos[3 x1] + 5036 Cos[4 x1] - 
                1684 Cos[5 x1] + 412 Cos[6 x1] - 
                304 Sqrt[2] Sqrt[
                 2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                  888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                  5 Cos[6 x1]] + 
                55 Sqrt[2] Cos[3 x1] Sqrt[
                 2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                  888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                  5 Cos[6 x1]] - 
                16 Sqrt[2] Cos[4 x1] Sqrt[
                 2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                  888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                  5 Cos[6 x1]] + 
                3 Sqrt[2] Cos[5 x1] Sqrt[
                 2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                  888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                  5 Cos[6 x1]] - 
                4 Cos[2 x1] (-6041 + 
                   48 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]]) + 
                2 Cos[x1] (-15698 + 
                   99 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]]) - 76 Cos[7 x1] + 
                7 Cos[8 x1]) (Cos[2 y1] + I Sin[2 y1]))/((-40 + 
                14 Cos[x1] - 8 Cos[2 x1] + 2 Cos[3 x1] + 
                Sqrt[2] Sqrt[
                 2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                  888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                  5 Cos[6 x1]]) (-180 + 148 Cos[x1] + 42 Cos[3 x1] - 
                12 Cos[4 x1] + 2 Cos[5 x1] + 
                3 Sqrt[2] Sqrt[
                 2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                  888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                  5 Cos[6 x1]] + 
                Cos[2 x1] (-128 + 
                   Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]])))]^2 + 
          1/16 Abs[((2158 - 864 Cos[3 x1] + 274 Cos[4 x1] - 
                 64 Cos[5 x1] + 7 Cos[6 x1] - 
                 28 Sqrt[2] Sqrt[
                  2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                   888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                   5 Cos[6 x1]] + 
                 3 Sqrt[2] Cos[3 x1] Sqrt[
                  2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                   888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                   5 Cos[6 x1]] + 
                 Cos[2 x1] (1913 - 
                    12 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]]) + 
                 7 Cos[x1] (-416 + 
                    3 Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]])) Tan[x1/
                2]^2)/((-2 + Cos[x1]) (-180 + 148 Cos[x1] + 
                 42 Cos[3 x1] - 12 Cos[4 x1] + 2 Cos[5 x1] + 
                 3 Sqrt[2] Sqrt[
                  2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                   888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                   5 Cos[6 x1]] + 
                 Cos[2 x1] (-128 + 
                    Sqrt[2] Sqrt[
                    2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                    888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                    5 Cos[6 x1]])))]^2 + 
          Abs[((-56 + 42 Cos[x1] - 24 Cos[2 x1] + 6 Cos[3 x1] + 
                Sqrt[2] Sqrt[
                 2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 
                  888 Cos[3 x1] + 278 Cos[4 x1] - 56 Cos[5 x1] + 
                  5 Cos[6 x1]]) (Cos[2 y1] + I Sin[2 y1]) Tan[x1/
               2]^2)/(-40 + 14 Cos[x1] - 8 Cos[2 x1] + 2 Cos[3 x1] + 
              Sqrt[2] Sqrt[
               2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
                278 Cos[4 x1] - 56 Cos[5 x1] + 
                5 Cos[6 x1]])]^2) (-40 + 14 Cos[x1] - 8 Cos[2 x1] + 
         2 Cos[3 x1] + 
         Sqrt[2] Sqrt[
          2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
           278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]]) (-180 + 
         148 Cos[x1] + 42 Cos[3 x1] - 12 Cos[4 x1] + 2 Cos[5 x1] + 
         3 Sqrt[2] Sqrt[
          2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
           278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]] + 
         Cos[2 x1] (-128 + 
            Sqrt[2] Sqrt[
             2154 - 2896 Cos[x1] + 1915 Cos[2 x1] - 888 Cos[3 x1] + 
              278 Cos[4 x1] - 56 Cos[5 x1] + 5 Cos[6 x1]])) (Cos[y1] -
          I Sin[y1])^2)];

threshold = 10^-4;
normEvec3deg[x1_, y1_] := 
  Quiet[Chop[normEvec3[x1 Degree, y1 Degree], 
    threshold], {Power::infy, Infinity::indet}];

(*Define the boundary condition explicitly*)
normEvec3deg[0, y1_] := 0;

(*Define the range of interest*)
x1Min = 0;
x1Max = 180;
y1Min = 0;
y1Max = 360;
yStep = 5;

(*Set up a table to store the results*)
resultsTable = {};

(*Function to automatically select well-behaved points for \
interpolation*)
SelectWellBehavedPoints[x1_] := 
  Module[{x1Val1, x1Val2, x1Val3, x1Val4},
   (*Select points dynamically based on current x1 value*)
   If[x1 < 50,
    (*If x1 is below 50,use points between 50 and 180*)x1Val1 = 50;
    x1Val2 = 60;
    x1Val3 = 70;
    x1Val4 = 100,
    (*If x1 is near the indeterminate region,avoid[87,93]*)
    If[87 <= x1 <= 93, x1Val1 = 70;
     x1Val2 = 85;(*Below the problematic region*)
     x1Val3 = 94;(*Just above the problematic region*)
     x1Val4 = 120,(*Further well-behaved point*)
     (*Else,use default values when x1 is well-behaved*)
     x1Val1 = Max[50, x1 - 20];
     (*Dynamically choose values relative to x1*)
     x1Val2 = Max[50, x1 - 10];
     x1Val3 = Min[180, x1 + 10];
     x1Val4 = Min[180, x1 + 20]]];
   Return[{x1Val1, x1Val2, x1Val3, x1Val4}]];

For[y1 = y1Min, y1 <= y1Max, y1 += yStep,
  For[x1 = x1Min, x1 <= x1Max, 
    x1 += 1,(*Check if x1 is in the indeterminate or non-
    smooth region*)
    If[(x1 < 50) || (87 <= x1 <= 93),(*Automatically select well-
      behaved points for interpolation*)
      {x1Val1, x1Val2, x1Val3, x1Val4} = SelectWellBehavedPoints[x1];
      (*Perform interpolation using well-behaved points*)
      interpolatedValue = 
       Interpolation[{{0, normEvec3deg[0, y1]}, {x1Val1, 
           normEvec3deg[x1Val1, y1]}, {x1Val2, 
           normEvec3deg[x1Val2, y1]}, {x1Val3, 
           normEvec3deg[x1Val3, y1]}, {x1Val4, 
           normEvec3deg[x1Val4, y1]}}, InterpolationOrder -> 3][x1];
      (*Append the valid {x1,y1,interpolatedValue} to resultsTable*)
      AppendTo[resultsTable, {x1, y1, N[interpolatedValue]}],
      (*Otherwise,directly evaluate normEvec3deg in the well-
      behaved region*)
      AppendTo[resultsTable, {x1, y1, normEvec3deg[x1, y1]}]];
    ];
  ];

(*Plotting the results using ListPlot3D*)
ListPlot3D[resultsTable, AxesLabel -> {"x1", "y1", "Value"}, 
 PlotRange -> {-1, 1}, ColorFunction -> Hue, InterpolationOrder -> 3]

After applying FullSimplify to the full 4 vector I now have the following simplified expression for

evector3a[x, y] = {{-E^(2 I y)}, {-((
   E^(2 I y) (-56 + 42 Cos[x] - 24 Cos[2 x] + 6 Cos[3 x] + 
      Sqrt[2] Sqrt[
       2154 - 2896 Cos[x] + 1915 Cos[2 x] - 888 Cos[3 x] + 
        278 Cos[4 x] - 56 Cos[5 x] + 5 Cos[6 x]]) Tan[x/2]^2)/(-40 + 
    14 Cos[x] - 8 Cos[2 x] + 2 Cos[3 x] + 
    Sqrt[2] Sqrt[
     2154 - 2896 Cos[x] + 1915 Cos[2 x] - 888 Cos[3 x] + 
      278 Cos[4 x] - 56 Cos[5 x] + 5 Cos[6 x]]))}, {((-24 + 
     78 Cos[x] - 24 Cos[2 x] + 2 Cos[3 x] + 
     Sqrt[2] Sqrt[
      2154 - 2896 Cos[x] + 1915 Cos[2 x] - 888 Cos[3 x] + 
       278 Cos[4 x] - 56 Cos[5 x] + 5 Cos[6 x]]) Csc[x]^2)/(
  16 (-2 + Cos[x]))}, {1}}

The first element simplifies to -e^2iy. Vector evector3a[x, y] is not normalized, but it's significantly simpler than the original expression for normEvec3[x1_, y1_].

Improve this answer
$\endgroup$
2
  • $\begingroup$ Complications come with normalizing. The norm is the beast to simplify. $\endgroup$
    – azerbajdzan
    Commented Sep 22 at 15:33
  • $\begingroup$ I do remember now using Norm originally and I did not get as many headaches. I did not connect the dots and realize I should have gone back to it. Many thanks, @azerbajdzan $\endgroup$
    – Quantum Kid
    Commented Sep 22 at 15:44
0
$\begingroup$

After applying the FullSimplify function to the 4-vector, and using the Norm function instead of Normalize function, (plus using some of the method outlined in the discussion section) I can now easily plot normEvec3[x1_, y1_] which is renamed as normevector3b11[x_, y_] using the following code:

ormnew[x_, y_] := Simplify[Norm[evector3a[x, y]]]

evector3a11[x_, y_] := evector3a[x, y][[1]];


normevector3b11[x_, y_] := evector3a11[x, y]/normnew[x, y];

re311bplot = 
  Plot3D[Re[normevector3b11[x Degree, y Degree]], {x, -180, 180}, {y, 
    0, 360}, ColorFunction -> Hue, PlotPoints -> 80, 
   PlotRange -> {{0, 180}, {0, 360}, {-1, 1}}, ImageSize -> 500, 
   WorkingPrecision -> 20, Exclusions -> None, Mesh -> {36, 18}];

im311bplot = 
  Plot3D[Im[normevector3b11[x Degree, y Degree]], {x, -180, 180}, {y, 
    0, 360}, ColorFunction -> Hue, PlotPoints -> 80, 
   PlotRange -> {{0, 180}, {0, 360}, {-1, 1}}, ImageSize -> 500, 
   WorkingPrecision -> 20, Exclusions -> None, Mesh -> {36, 18}];

{Show[re311bplot, re311plot], Show[im311bplot, im311plot]}

and I get the following real (left) and imaginary (right) plots:

enter image description here

Improve this answer
$\endgroup$

Your Answer

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

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