ListPlot3D to show the dependence of a spectrum on a parameter?

Questions
, , , ,
1

In solving a differential equation, I would like to visualize how the spectrum of the solutions depend on a parameter.
The code I am working on is:

maxTime = 100; eqn = {\[CapitalTheta]''[t] + (1/(1 - 0.1 Cos[\[Alpha] *t])) Sin[\[CapitalTheta][t] ] == 0, \[CapitalTheta][0] == 0, \[CapitalTheta]'[0] ==0.1}
sol = ParametricNDSolveValue[eqn, \[CapitalTheta], {t, 0, maxTime}, {\[Alpha] }];
alphaTable = Table[sol[\[Alpha]], {t, 0, maxTime}];
data = Table[Periodogram[alphaTable[\[Alpha]]], {\[Alpha] , 1.5, 2.5, 0.01}];
lowRange = maxTime / 10;
highRange = maxTime / 4;
ListPlot3D[[data], PlotRange -> {{lowRange, highRange}, All}]

My thought is that since ‘sol’ is a function of t and alpha, I should be able to generate a table for a fixed alpha, and get the spectrum for that using Periodogram. Then, I am trying to build a table of all the spectra and use ListPlot3D to visualize it.

Somewhere I am missing something; while I can get each individual spectrum for a fixed value of alpha, I am failing to merge them into the kind of object that ListPlot3D can work with.

2

You have to extract the values from the Periodgram plots. Here is one way:

maxTime = 100; eqn = {\[CapitalTheta]''[
     t] + (1/(1 - 0.1 Cos[\[Alpha]*t])) Sin[\[CapitalTheta][t]] == 
   0, \[CapitalTheta][0] == 0, \[CapitalTheta]'[0] == 0.1};
sol = ParametricNDSolveValue[
   eqn, \[CapitalTheta], {t, 0, maxTime}, {\[Alpha]}];
alphaTable[\[Alpha]_] := Table[sol[\[Alpha]][t], {t, 0, maxTime}];
data = Flatten[
   Table[Flatten[
     Cases[Periodogram[alphaTable[\[Alpha]]], 
      Line[pts_] :> Map[Prepend[\[Alpha]], pts], All], 1], {\[Alpha], 
     1.5, 2.5, 0.01}], 1];
lowRange = maxTime/10;
highRange = maxTime/4;
ListPlot3D[data]
3

Thanks for looking into this. When I copy your code and run it, errors are generated:

SetDelayed::write: Tag List in {ParametricFunction[1,InternalBag[<1>],0,1,{{\[Alpha]$370462},SystemUtilitiesHashTable[<2>],{},{},{1},{Automatic,0,0}},{NDSolvebase$370469,<<1>>}][[Alpha]],ParametricFunction[1,<<4>>,{NDSolve`base$370469,<<33>>[0,<<8>>,All]}][[Alpha]],<<47>>,<<1>>,<<51>>}[[Alpha]_] is Protected. >>
Periodogram::data: Expecting a SampledSoundList, a numeric vector, or a numeric matrix instead of {<<1>>}[1.5]. >>

I have carefully checked my typing (including the ‘:>’ which doesn’t copy/paste) – can you see what I might be doing wrong?

emaxTime = 100; eqn = {\[CapitalTheta]''[
     t] + (1/(1 - 0.1 Cos[\[Alpha] *t])) Sin[\[CapitalTheta][t] ] == 
   0, \[CapitalTheta][0] == 0, \[CapitalTheta]'[0] == .1}
sol = ParametricNDSolveValue[
  eqn, \[CapitalTheta], {t, 0, maxTime}, {\[Alpha] }]; 
alphaTable[\[Alpha]_] := Table[sol[\[Alpha]][t], {t, 0, maxTime}];
data = Flatten[
   Table[Flatten[
     Cases[Periodogram[alphaTable[\[Alpha]]], 
      Line[pts_] :> Map[Prepend[\[Alpha]], pts], All], 1], {\[Alpha], 
     1.5, 2.5, 0.01}], 1];
lowRange = maxTime/10;
highRange = maxTime/4;
ListPlot3D[data]
4

Copy and paste works fine for me. However, I am enclosing the file.

5

Again, thanks for all your help. I have studied your notebook, and I think something is wrong with the results. Your table manipulation logic eludes me, but the results don’t make sense (for example, if you do a line plot of the spectrum at a single value of alpha, it doesn’t look at all like the corresponding section of the 3D plot).
After a day of playing around with it, I think I have a much simpler solution using PeriodogramArray[]:

maxTime = 100; eqn = {\[CapitalTheta]''[
     t] + (1/(1 - 0.1 Cos[\[Alpha]*t])) Sin[\[CapitalTheta][t]] == 
   0, \[CapitalTheta][0] == 0, \[CapitalTheta]'[0] == .1}
sol = ParametricNDSolveValue[
   eqn, \[CapitalTheta], {t, 0, maxTime}, {\[Alpha]}];
alphaTable[\[Alpha]_] := Table[sol[\[Alpha]][t], {t, 0, maxTime}];
spectrum[\[Alpha]_] := PeriodogramArray[alphaTable[\[Alpha]]];
data = Table[spectrum[\[Alpha]], {\[Alpha], 1.9, 2.1, 0.001}];
lowRange = maxTime/10;
highRange = maxTime/4;
ListPlot3D[data, PlotRange -> {{lowRange, highRange}, All, Full}]

spectrum-100.jpg
spectrum-100.jpg373×180 11.6 KB

The numbers on the axes need to be scaled (alpha goes from 0 to 200 rather than 1.9 to 2.1), but other than that, this result looks right to me.