# Show two plots together: a two dimensional curve tangent to the maxima of a three dimensional plot

I have a list containing 3 columns and 6552 rows which can be found here.

The plot of data is shown below: We have a cross cut for a specific value of y, for example, y=0.01 or y=1.26 over this plot by (mathematica.dat is the uploaded file):

data3D = Import["mathematica.dat", "Table"];
yequalto01 = Rest /@ (Select[data3D, #[] == 0.01 &]);
yequalto126 = Rest /@ (Select[data3D, #[] == 1.26 &]);


From a two column data (yequalto01,yequalto126) we can extract the peaks by peakValues = Pick[yequalto01, PeakDetect[yequalto01[[;; , 2]]], 1];

This list except the last pair can be presented as

peakValues ={{0.0, 1.000}, {4.4, 0.982}, {8.9, 0.961}, {13.3, 0.942}, {17.8, 0.923}, {22.2, 0.906}};


We plotted peakValues and drawn data3D separately. But, I wish to show two plots simultaneous in one figure as the below one which prepared by paint (blue and purple curves are tangent to the peaks of the 3D plot). • You can combine plots using Show. Aug 18 '19 at 7:39

peakValues01 =
Pick[yequalto01, PeakDetect[yequalto01[[;; , 2]]], 1][[;; -2]];
peakValues126 =
Pick[yequalto126, PeakDetect[yequalto01[[;; , 2]]], 1][[;; -2]];

p01 = Join[{ConstantArray[0.01, Length[peakValues01]]},
peakValues01\[Transpose]]\[Transpose];
p126 = Join[{ConstantArray[1.26, Length[peakValues126]]},
peakValues126\[Transpose]]\[Transpose];

Show[
ListPlot3D[data3D],
ListPointPlot3D[p01],
Graphics3D@Line@p01,
ListPointPlot3D[p126],
Graphics3D@Line@p126
] Of course, you can customise the lines/dots as you want with the standard options. If you want smooth lines between the points, I would try with interpolating first and then a ParametricPlot:

p01f[x_] = Interpolation[peakValues01][x];
p126f[x_] = Interpolation[peakValues126][x];

htl = Join[{#*\[Pi], #*\[Pi], {0.014, 0}} & /@
Range[0, 8, 2], {#*\[Pi], "", {0.01, 0}} & /@ Range[0, 8, 1]];

Show[
ListPlot3D[data3D, ColorFunction -> "TemperatureMap", Mesh -> None
, Ticks -> {Automatic, htl, Automatic}, BoxStyle -> Dashed,
AxesLabel -> {"y", "x"}],
ListPointPlot3D[p01, PlotStyle -> {Purple}],
ListPointPlot3D[p126, PlotStyle -> {Blue}],
ParametricPlot3D[{0.01, x, p01f[x]}, {x, 0., 25.1}, {y, 0, 1.26},
PlotStyle -> {Purple, Thickness[0.02]}],
ParametricPlot3D[{1.26, x, p126f[x]}, {x, 0., 25.1}, {y, 0, 1.26},
PlotStyle -> {Blue, Thickness[0.02]}],
ViewPoint -> {4, 1, 1}
] {y01, y126} = Table[Select[data3D, #[] == i &], {i, {.01, 1.26}}];

{peaks01, peaks126} = Pick[#, PeakDetect[#[[;; , 3]]], 1] & /@ {y01, y126};

Show[ListPlot3D[data3D],
Graphics3D[{PointSize[Large], Thick, Red, Line @ peaks01, Point @ peaks01,
Green, Line @ peaks126, Point@ peaks126}]] 