Show two plots together: a two dimensional curve tangent to the maxima of a three dimensional plotnto44 tabefotr
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, #[[1]] == 0.01 &]);
yequalto126 = Rest /@ (Select[data3D, #[[1]] == 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).
2 Answers
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, #[[1]] == 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}]]
Show. $\\endgroup$ – C. E. 17 hours ago