2

I read this article and I tried to make a simple analog

tako = Import[
"C:\\Users\\User\\Desktop\\tako\\kk\\My recording #2.wav"];


maxx = AudioBlockMap[Max, tako, {0.055, 0.001, HammingWindow}]

enter image description here

Show[AudioPlot[tako, AspectRatio -> 1/2, PlotRange -> All], 
ListLinePlot[maxx, PlotStyle -> Red], ImageSize -> 800]

enter image description here

then I tried

RevolutionPlot3D[InterpolatingPolynomial[maxx["Path"], x], {x, 0, 3}]

but it doesn't work.

does there exist a simple way to make RevolutionPlot3D[] from the TimeSeries?

(see "tako" audio file here)

vito
  • 8,958
  • 1
  • 25
  • 67

2 Answers2

4

You are using InterpolatingPolynomial, which results in an interpolation by a polynomial of order Length[max["Path"]]-1=2824. What you probably want instead if a piecewise interpolation, which can be done as follows:

if = Interpolation[maxx["Path"], InterpolationOrder -> 1];
RevolutionPlot3D[if[x], Evaluate@{x, Sequence @@ First@if["Domain"]}]

Mathematica graphics

You can also decide to rotate around the X axis with option RevolutionAxis -> "X":

RevolutionPlot3D[if[x], Evaluate@{x, Sequence @@ First@if["Domain"]}, 
 PlotPoints -> 100, RevolutionAxis -> "X", MaxRecursion -> 4,PlotRange -> Full]

Mathematica graphics

anderstood
  • 14,301
  • 2
  • 29
  • 80
3

The approach I used in this previous answer can also be used here; that is, one can directly construct a BSplineSurface[] corresponding to the desired surface of revolution, without needing to use RevolutionPlot3D[]:

tako = Import["My recording #2.wav"];
maxx = AudioBlockMap[Max, tako, {0.055, 0.001, HammingWindow}];
path = maxx["Path"];

circPoints = {{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1, 0}};
circKnots = {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1};
circWts = {1, 1/2, 1/2, 1, 1/2, 1/2, 1};

Graphics3D[BSplineSurface[Map[Function[pt, Append[#2 pt, #1]], circPoints] & @@@ path, 
                          SplineClosed -> True, SplineDegree -> {1, 2}, 
                          SplineKnots -> {Automatic, circKnots}, 
                          SplineWeights -> ConstantArray[circWts, Length[path]]], 
           Boxed -> False]

surface of revolution

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574