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$
3
  • $\begingroup$ Is the DataRange option inadequate to your needs? $\endgroup$
    – Alan
    Apr 11, 2017 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, 2017 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, 2017 at 15:07

1 Answer 1

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$
1
  • $\begingroup$ Excellent thank you! $\endgroup$
    – PROGREEN
    Apr 14, 2017 at 9:03

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.