Pick out elements from a list of lists using criteria

Question

Consider a list of lists in this form (with a shape $ m \times n \times 3 $):

{
 {{a1, R1, c11}, {a2, R1, c12}, {a3, R1, c13}, ..., {an, R1, c1n}},
 {{a1, R2, c21}, {a2, R2, c22}, {a3, R2, c23}, ..., {an, R2, c2n}},
 ...,
 {{a1, Rm, cm1}, {a2, Rm, cm2}, {a3, Rm, cm3}, ..., {an, Rm, cmn}}
}

where in each outer list, the 2nd element $ R_i $ is fixed ($ i = 1, 2, ..., m $), and the 1st element changes from $ a_1 $ to $ a_n $, the 3rd element $ c_{ij} $ is normally a complex and its imaginary part can change from positive to negative or from negative to positive for several times. Here is a sample data for test.

I want to pick out the neighbor lists whenever the imaginary part of $ c_{ij} $ changes its sign, say, for $ R_2 $, the selected lists are something like $ \{a_j, R_2, c_{2j}\} $ and $ \{a_{j+1}, R_2, c_{2,j+1}\} $, where $ \text{Im} c_{2,j} < 0 $ and $ \text{Im} c_{2,j+1} > 0 $. More generally, for $ R_p $ I pick out $ \{a_j, R_p, c_{pj}\} $ and $ \{a_{j+1}, R_p, c_{p,j+1}\} $, and then to plot a curve with ListLinePlot[{{R1, a01}, {R2, a02}, ..., {Rp, a0p}, ..., {Rm, a0m}}], in which $ a_{0j} = (a_j + a_{j+1}) / 2 $. In other words, I what to plot a parameter curve w.r.t the 1st and 2nd elements, across which the imaginary part of the 3rd element changes sign.

I tried Cases, Select and ParametricPlot, but I am still having trouble to find all the pairs of the neighboring lists when the imaginary part of $ c_{ij} $ changes its sign.

Answer 1

I imported your test data into a file called test.csv. On my Mac, this resulted in a set of strings, so I had to do a quick fixup to get data in the format you mentioned.

Would something like this be what you want?

ClearAll[testData, testDataFixed, theValues, calculatedValues];
testData = Import["~/Downloads/test.csv"];
testDataFixed = Map[ToExpression, testData, {2}];
theValues = 
  Cases[Partition[#, 2, 1], {{a_, b_, c_}, {d_, e_, f_}} /; 
      Sign[Im[c]] != Sign[Im[f]]] & /@ testDataFixed;
calculatedValues = 
  Flatten[Map[{#[[1, 2]], (#[[1, 1]] + #[[2, 1]])/2} &, 
    theValues, {2}], 1];
ListPlot[calculatedValues]

This gives the following plot: I will note that due to the test for Sign, if the first element has no imaginary part and the second does, then this will also get flagged. I can modify this if you want to make sure that there really is an imaginary component that is changing sign.

A minor change to eliminate the cases when there is no imaginary part:

theValues = 
  Cases[Partition[#, 2, 
      1], {{a_, b_, c_}, {d_, e_, 
        f_}} /; (Sign[Im[c]] != Sign[Im[f]]) && (Sign[Im[c]] != 
         0) && (Sign[Im[f]] != 0)] & /@ testDataFixed;

This eliminates the values that were showing up at the bottom, giving this graph:

OK, one more edit to split into clusters:

ListLinePlot[FindClusters[calculatedValues]]

Giving:

Answer 2

You can use SequenceCases to construct pairs based on sign changes in imaginary part of the third columns:

ClearAll[f]
f = SequenceCases[#, {{a_, b_, c_}, {d_, e_, f_}} /; Sign[Im@c] != Sign[Im@f] :>        
     {b, (a + d)/2}, Overlaps -> True] & 

A data set with the structure described in OP:

SeedRandom[1]
m = 10; n = 5;
rr = Range[m];
aa = Range[n];
cc = Round[#, .01] & @ RandomComplex[{-5 - I, 5 + I}, {m, n}];
arc = Join[Transpose@Outer[List, aa, rr], Map[List, cc, {-1}], 3];

Grid[arc, Dividers -> All]

Use f on arc to get the desired output:

pairs = f /@ arc;

ListPlot[pairs]

Grid[N @ pairs, Dividers -> All]

Use arc = sampledata to get

and