1. Raw data:
I have a nested list of data (~120M in google drive) in the following form:
{{{{a1,b1,c11}},{{a2,b1,c21}},{{a3,b1,c311},{a3,b1,c321}},{{a4,b1,c411},{a4,b1,c421}},...,{{an,b1,cn11},{an,b1,cn21}}},
{{{a1,b2,c12}},{{a2,b2,c22}},{{a3,b2,c312},{a3,b2,c322}},{{a4,b2,c412},{a4,b2,c422}},...,{{an,b2,cn12},{an,b2,cn22}}},
...,
{{{a1, bm, c1m}},{{a2, bm, c2m}},{{a3, bm, c31m},{a3, bm, c32m}},{{a4, bm, c41m},{a4, bm, c42m}},...,{{an, bm, cn1m},{an, bm, cn2m}}}}
2. Key features of the list:
Some sublists have a single ordered triple of numbers, e.g.
{{a1,b1,c11}}which could be considered an element $(a_j,b_i,c_{ji})$ in a matrix form with row index $i$ and column index $j$, where $c_{ji}$ is a complex number corresponding to $(a_j,b_i)$; most sublists include 2 triples, e.g.{{a3,b1,c311},{a3,b1,c321}}which could be considered an element $(a_j,b_i,c_{j1i},c_{j2i})$ in a matrix form, where $c_{j1i}$ and $c_{j2i}$ are 2 different complex numbers corresponding to $(a_j,b_i)$;The
{-2}level is the level of the triples in the nested list;The first element $a_j$ ($j=1,...,n$) changes from $a_1$ to $a_n$ in each row;
The second element $b_i$ ($i=1,...,m$) is a constant throughout the $i$-th row;
If plotting $(a_j,Im[c_{ji}])$ for the $i$-th row (i.e. for a given $b_i$), where $Im$ takes the imaginary part, we normally have two curves: an upper one and a lower one. In particular, when $b_i$ is relatively small, the two curves remain below the $Im[c]=0$ axis; when $b_i$ becomes larger, the upper curve has two cross points with $Im[c]=0$ axis, while the lower upper is below the $Im[c]=0$ axis; when $b_i$ becomes large enough, the upper curve has one crossing point with $Im[c]=0$ axis at a small $a$ (another crossing point normally at a very large $a$), while the lower curve has two crossing points with the $Im[c]=0$ axis at small $a$ values.
Some examples are plotted for illustration:
pts = ToExpression/@Import["~\\testdata.csv"];
(*b index: nb = (b-0.01)*500+1*)
listb0p05 = pts[[21]] /. {a_, b_, c_} -> {a, Im[c]};
cib0p05Lst = Flatten[listb0p05, 2] // Partition[#, 2] &;
b0p05pts = ListPlot[cib0p05Lst, Frame -> True, PlotRange -> {{0, 10}, {-1, 0.2}}, PlotStyle -> Red, ImageSize -> 400, AspectRatio -> 0.3]
listb0p2 = pts[[96]] /. {a_, b_, c_} -> {a, Im[c]};
cib0p2Lst = Flatten[listb0p2, 2] // Partition[#, 2] &;
b0p2pts = ListPlot[cib0p2Lst, Frame -> True, PlotRange -> {{0, 10}, {-1, 0.55}}, PlotStyle -> Red, ImageSize -> 400, AspectRatio -> 0.3]
listb0p8 = pts[[396]] /. {a_, b_, c_} -> {a, Im[c]};
cib0p8Lst = Flatten[listb0p8, 2] // Partition[#, 2] &;
zoomb0p8pts = ListPlot[cib0p8Lst, Frame -> True, PlotRange -> {{0, 0.3}, {-10, 8}},
PlotStyle -> Red, ImageSize -> 400, AspectRatio -> 0.3]
b0p8pts = ListPlot[cib0p8Lst, Frame -> True, PlotRange -> {{0, 10}, {-30, 40}},
PlotStyle -> Red, ImageSize -> 400, AspectRatio -> 0.3]
listb0p95 = pts[[471]] /. {a_, b_, c_} -> {a, Im[c]};
cib0p95Lst = Flatten[listb0p95, 2] // Partition[#, 2] &;
zoomb0p95pts = ListPlot[cib0p95Lst, Frame -> True, PlotRange -> {{0, 0.1}, {-60, 40}}, PlotStyle -> Red, ImageSize -> 400]
b0p95pts = ListPlot[cib0p95Lst, Frame -> True, PlotRange -> {{0, 10}, {-80, 420}}, PlotStyle -> Red, ImageSize -> 400]
3. What I am trying to plot:
For each $b_i$, I want to find all the adjacent points $(a_j,Im[c_{ji}])$ and $(a_{j+1},Im[c_{j+1,i}])$ on each curve $(a,Im[c])$, between these 2 points the curve intersects with the $Im[c]=0$ axis and then plot the points $(b_i, a0_i)$ (i.e. a root) by interpolating $a_j$ and $a_{j+1}$ (please see the following code).
Because the upper/lower curves could have 2 crossing points, so there could be two $a0_i$ corresponding to a single $b_i$. In this case, there will be two root curves on $(b,a0)$ plane for the upper and lower curves, respectively. For large enough $b_i$, the upper curve has one crossing point at small $a$ (another one at large $a$ is out of range), and the lower curve has two crossing points at small $a$, in this case, there would be three (short) curves on $(b,a0)$ plane. Btw, to show the root curves at small $a$, a log scale for $a$ should be appropriate.
I have tried the following simple code, but because I did not know how to separate the upper and lower curves in the interlaced sublists, the method failed because there are two curves. I believe if there is only a single curve, this code should work.
Please give me some suggestions on how to plot the desired root curves on $(b,a0)$-plane with the topological changing upper/lower curves on $(a, Im[c])$-plane. Thank you very much!
revcI = Cases[Partition[#, 2, 1], {{{a_, b_, c_}}, {{d_, e_, f_}}} /; (Sign[Im[c]] !=
Sign[Im[f]]) && (Sign[Im[c]] != 0) && (Sign[Im[f]] != 0)] & /@ pts;
(*interpolating for the a0*)
cIzeroInterpolation = Flatten[Map[{#[[1, 1, 2]], (#[[1, 1, 1]]*Im[#[[2, 1, 3]]] - #[[2, 1, 1]]*Im[#[[1, 1, 3]]])/(Im[#[[2, 1, 3]]] - Im[#[[1, 1, 3]]])} &, revcI, {2}], 1];
ListPlot[cIzeroInterpolation, Frame -> True, Axes -> False, PlotRange ->All, FrameLabel -> {"b", "a0"}]
4. Appendix (according to some comments):
- This is an illustration with $b_i=0.2$ for discussion on root finding according to the comment by @Daniel Lichtblau.
Forward difference: $$\left.\frac{d Im[c]}{d a}\right\vert_j=\frac{Im[c_{j+1,i}]-Im[c_{ji}]}{a_{j+1}-a_j}$$
Backward difference: $$\left.\frac{d Im[c]}{d a}\right\vert_{j+1}=\frac{Im[c_{j+1,i}]-Im[c_{ji}]}{a_{j+1}-a_j}$$
Note: the increment of the $a_j$ in the list is a constant: $a_{j+1}-a_j=0.005$.
- This is an illustration for discussion on distinguishing the roots according to the comment by @Victor K.
