0
$\begingroup$

I have some code that takes a list of energies, plugs them into a set of recursion relations and numerically solves for each energy (15 energies total) and for each n(modes, 21 total)

\[HBar] = 1;
m = 1;

Do[Energy[z] = 0.5 + 2 z, {z, 0, 14}]
Table[Energy[z], {z, 0, 14}];
Do[Entot[n, o] = Energy[o] - \[HBar]*\[Omega]*n, {n, -10, 10}, {o, 0, 
  14}]
Do[k[n, o] = 2*m*(Entot[n, o])^(1/2), {n, -10, 10}, {o, 0, 14}]

\[Omega] = 1;
s = 10;
k0 = -6;
\[Alpha] = 4;
t0 = 1;
t[-11] = 0.01;
t[11] = 0.01;
r[-11] = 0.01;
r[11] = 0.01;
ClearAll[plot1]
Do[eqn[n, o] = -t[n] + 
KroneckerDelta[n, 
     1] + (s*m/(2*\[HBar]^2*I*k[n, o]))*(t[n - 1] + 
       t[n + 1]), {n, -10, 10}, {o, 0, 14}];
tab1 = Table[eqn[n, o], {o, 0, 14}, {n, -10, 10}];
tab2 = Table[t[n], {n, -10, 10}];

Do[plot1[p] = NSolve[tab1[[p]] == 0, tab2], {p, 1, 15}]
Do[f[n, o] = t[n] /. plot1[o], {n, -10, 10}, {o, 1, 15}]
ListPlot[Abs[
  Table[Flatten[Table[f[n, o], {n, -10, 10}]], {o, 1, 15}]], 
 PlotRange -> {0, 1.5}]

The problem is I need the ListPlot to use the values {n,-10,10} as the x values rather than the index of the list. I tried doing

ListPlot[Abs[
  Table[Flatten[Table[{n,f[n, o]}, {n, -10, 10}]], {o, 1, 15}]], 
    PlotRange -> {0, 1.5}]

but I think there's a problem with the syntax and the list manipulation.

$\endgroup$
  • $\begingroup$ Is the DataRange option inadequate to your needs? $\endgroup$ – Alan Apr 11 '17 at 12:26
  • $\begingroup$ I don't think that's what I need, I virtually just need my graph to shift to the left by 11 $\endgroup$ – PROGREEN Apr 11 '17 at 14:09
  • $\begingroup$ You can explicitly put the value in the list like Table[{n,Abs[f[n, o]]}, {n, -10, 10}] (you will need to tell Flatten to just flatten one level, Flatten[Table[],1] ) $\endgroup$ – george2079 Apr 11 '17 at 15:07
0
$\begingroup$

I am pretty sure DataRange does what you want. I also changed the computation to more standard WL usage.

ClearAll[energy, entot, kt, tt]
\[HBar] = 1; m = 1;
energy = Array[0.5 + 2 # &, 15, 0];
entot = Outer[#2 - \[HBar]*\[Omega]*#1 &, Range[-10, 10], energy];
k = 2*m*entot^(1/2);
tab2 = Array[t[#] &, 21, -10];
tt = Array[t[# - 1] + t[# + 1] &, 21, -10];
eqnNew = -tab2 + ((s*m/(2*\[HBar]^2*I))/knew)*tt;
eqnNew[[12]] += 1;
tab1 = Transpose@eqnNew;
\[Omega] = 1; s = 10; t[-11] = 0.01; t[11] = 0.01;
data = Abs[ReplaceAll[tab2, #] & /@ (NSolve[tab1[[#]] == 0, tab2] & /@ Range[15])];
g1 = Labeled[ListPlot[Flatten[data, 1], PlotRange -> {0, 1.5}], 
   "Old Range", Top];
g2 = Labeled[ListPlot[Flatten[data, 1], PlotRange -> {0, 1.5},
    DataRange -> {-10, 10}], "New Range", Top];

Effect:

enter image description here

$\endgroup$
  • $\begingroup$ Excellent thank you! $\endgroup$ – PROGREEN Apr 14 '17 at 9:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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