How to get a line density from list density plot?

Question

I have a list density plot from a list ls={{x1,y1,z1},{x2,y2,z2}}.... How can I extract the line density with a fix y, such that I could get a ListPlot {{xi,zi},{xj,zj}}.... Please start from list ls or the graph p1, avoid using the functions, they are only used to generate the list.

The graph in ListDensityPlot is smooth, so I would require the ListPlot also be smooth. However, the list ls may not be very dense. Below is the code creating the list and ListDensityPlot:

(*Creating a list ls*)
f[x_] := Sqrt[1 - x];
stepSize = 100/1000;
ls0 = Table[{x, f[x]}, {x, 0, 1, stepSize}];
ls1 = Flatten[
   Table[{#[[1]], y, Exp[y - #[[2]]] - 1}, {y, #[[2]], 1.5, 
       stepSize}] & /@ ls0, 1];
ls2 = Flatten[
   Table[{#[[1]], y, 0}, {y, 0, #[[2]], stepSize}] & /@ ls0, 1];
ls = Join[ls1, ls2];
(*Draw the ListDensity of ls*)

p1 = ListDensityPlot[ls, PlotLegends -> Automatic];
p2 = Plot[{0.83, 1.14}, {x, 0, 1}, 
   PlotStyle -> {{Dashed, Red}, {Dashed, Green}}];
Show[p1, p2]
ListPointPlot3D[ls]

For example, how to extract the red and green dashed line smoothly?

It can be seen that the points may not be dense.

Answer 1

An alternative, which is my go-to method of extracting these kinds of things. First construct a 3D-plot of the data using Mesh lines that sit at y-values of 0.83 and 1.14:

p3 = ListPlot3D[ls
  , PlotRange -> All
  , InterpolationOrder -> 1
  , MeshFunctions -> (#2 &), Mesh -> {{0.83, 1.14}}
  , BoundaryStyle -> None, Boxed -> False, Axes -> False]

Then extract the lines from the graph:

lns = Cases[Normal@p3, Line[a_] :> a, Infinity];
ListLinePlot /@ Apply[{#1, #3} &, lns, {2}]

To see the points, consider:

Plot[Interpolation[{#1, #3} & @@@ #, InterpolationOrder -> 0][t], {t, 0, 1}] & /@ lns

Answer 2

Extracting data directly from ListDensityPlot

make a grayscale plot:

p1 = ListDensityPlot[ls, PlotLegends -> Automatic, 
  ColorFunction -> GrayLevel]

extract the polynomials from the graphics , then the ones that cross the desired line:

polys = Cases[Normal@p1, Polygon[v_List, VertexColors -> c_List], 
   Infinity];
Graphics[{
  EdgeForm[{Thick, Blue}], 
   Select[ polys, 
    Max[#[[1, All, 2]]] > 1.14 && Min[#[[1, All, 2]]] < 1.14 & ],
  Red, Line[{{0, 1.14}, {1, 1.14}}]} ]

then extract the edges that cross..

tedges[poly_, y_] :=
 MapThread[{ {poly[[1, #1]], poly[[2, 2, #1]]}  , {poly[[1, #2]], 
     poly[[2, 2, #2]]} } & ,
  ({#, RotateLeft[#]} &@Range[Length@poly[[1]]])]
crossedges[polys_, y_] := 
  Select[  Flatten[
    tedges[#, y] & /@ (Select[ polys, 
       Max[#[[1, All, 2]]] > y && Min[#[[1, All, 2]]] < y & ]), 
    1] , ((Max[#[[All, 1, 2]] ] >= y && 
           Min[#[[All, 1, 2]] ] <= y) &)];

linear interpolate edge color along each edge:

intedge[edge_, y_] := 
 Module[{ ci = (y - edge[[2, 1, 2]])/(edge[[1, 1, 2]] - 
       edge[[2, 1, 2]])},
  {edge[[1, 1, 1]] ci + edge[[2, 1, 1]] (1 - ci)  , 
   edge[[1, 2]] ci + edge[[2, 2]] (1 - ci)}]
ListPlot[Union[intedge[#, 1.14] & /@ crossedges[polys, 1.14]]]

note the scale here is the grayscale.. go back and use ColorFunctionScaling->False for the plot..

and...after all that we see we have precisely the same result as JasonB's Interpolation..

Answer 3

So your interpolation function will suffer a bit since the data is on a non-rectangular grid. This is the case also for the density plot, you can see that the interpolation on the 2D plot isn't great.

intfunc = Interpolation[DeleteDuplicates@ls]

You can see that the result isn't perfectly smooth,

Plot[{intfunc[x, .83], intfunc[x, 1.14]}, {x, 0, 1}, 
 PlotStyle -> {Red, Green}]

But you can also see that it matches your data points as well

ListPointPlot3D[{ls, {#, .83, intfunc[#, .83]} & /@ 
   Range[0, 1, .1], {#, 1.14, intfunc[#, 1.14]} & /@ Range[0, 1, .1]},
  PlotStyle -> {{PointSize[.01], Blue}, {PointSize[.01], 
    Red}, {PointSize[.01], Green}}]