5
$\begingroup$

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

The plot of data is shown below:

Enter image description here

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).

Enter image description here

$\endgroup$
  • $\begingroup$ You can combine plots using Show. $\endgroup$ – C. E. Aug 18 at 7:39
7
$\begingroup$
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
 ]

enter image description here

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}
 ]

enter image description here

$\endgroup$
6
$\begingroup$
{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}]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.