2
$\begingroup$

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)

$\endgroup$
3
$\begingroup$

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

$\endgroup$
3
$\begingroup$

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

$\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.