Re: Representing musical timings on a helix
- To: mathgroup at smc.vnet.net
- Subject: [mg127846] Re: Representing musical timings on a helix
- From: Bob Hanlon <hanlonr357 at gmail.com>
- Date: Sun, 26 Aug 2012 05:44:50 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- Delivered-to: l-mathgroup@wolfram.com
- Delivered-to: mathgroup-newout@smc.vnet.net
- Delivered-to: mathgroup-newsend@smc.vnet.net
- References: <20120817074724.C276F685F@smc.vnet.net>
data = Flatten[{{{0.0348299}, {0.476009}, {0.940408}, {1.3932}, {1.84599}, \
{2.29878}, {2.75156}, {3.18113}}}];
len = Length[data];
c = Interpolation[data];
While the interpolation exactly matches each of the original data points
c /@ Range[len] == data
True
The rescaling assumes a linear relationship and consequently even only
approximately maps the data back onto itself--being exact only at the
end points.
data - c /@ (Rescale[#, {Min[data], Max[data]}, {1, len}] & /@ data)
{2.77556*10^-17, 0.00845665, -0.00674009, -0.0100293, -0.0133724, -0.0168578, \
-0.0196822, 0.}
Consequently, I should not have recommended Rescale and instead should
have recommended using an InverseFunction of c
g = InverseFunction[c];
c[g[t]] == t // Quiet
True
c /@ (g /@ data) == data
True
g[c[n]] == n
True
g /@ (c /@ Range[len]) == Range[len]
True
data2 = Flatten[{{0.0348299}, {0.476009}, {0.940408}, {.99870}, {1.3257}, \
{1.5655}}];
k = 1/4;
n = 1;
pt[t_, k_, n_] = {1/4 c'[t]*Cos[2 Pi*t/n], 1/4 c'[t]*Sin[2 Pi*t/n], k*c[t]};
helix = ParametricPlot3D[pt[t, k, n], {t, 1, len}];
dataPoints = Graphics3D[{
AbsolutePointSize[6],
Red,
Point[Table[pt[t, k, n], {t, 1, len}]]}];
data2Points = Graphics3D[{
AbsolutePointSize[4],
Blue,
Point[pt[#, k, n] & /@
(g /@ data2)]}];
Show[{helix, dataPoints, data2Points}]
Bob Hanlon
On Sat, Aug 25, 2012 at 9:30 PM, andrew mcgraw <mcgraw.andrew at gmail.com> wrote:
> Hi Bob,
>
> Thank you very much! Yes, this is what I am going for. I need to plot both
> A) periodic points which define the curve, occurring once per cycle (the
> first data set, representing beat one of a full bar), and B) arbitrary,
> often non-periodic points along that curve (second data set). However, I'm
> noticing that when I simplify this script the second data set is skewing
> upward. For instance, the first two onsets in the second data set (red) are
> simultaneous with the first data set (blue), but do not align on the helix.
> Wondering if you might have ideas as to why.
>
> Regards,
> Andrew
>
>
> data = Flatten[{{{0.0348299}, {0.476009}, {0.940408}, {1.3932}, \
> {1.84599}, {2.29878}, {2.75156}, {3.18113}}}];
>
>
> len = Length[data];
>
> c = Interpolation[data];
>
> data2 = Flatten[{{0.0348299}, {0.476009}, {0.940408}, {.99870}, \
> {1.3257}, {1.5655}}];
>
> k = 1/4;
> n = 1;
>
> pt[t_, k_, n_] = {1/4 c'[t]*Cos[2 Pi*t/n], 1/4 c'[t]*Sin[2 Pi*t/n],
> k*c[t]};
>
> (* multiply c by 4 for scale *)
>
> helix = ParametricPlot3D[pt[t, k, n], {t, 1, len}];
>
> dataPoints =
> Graphics3D[{AbsolutePointSize[6], Red,
> Point[Table[pt[t, k, n], {t, 1, len}]]}];
>
> data2Points =
> Graphics3D[{AbsolutePointSize[4], Blue,
> Point[pt[Rescale[#, {Min[data], Max[data]}, {1, len}], k, n]] & /@
> data2}];
>
> Show[{helix, dataPoints, data2Points}]
>
>
>
>
>
>
>
> On Fri, Aug 24, 2012 at 11:45 PM, Bob Hanlon <hanlonr357 at gmail.com> wrote:
>>
>> If I understand what you want:
>>
>> data = Flatten[{
>> {{0.0348299}, {0.476009}, {0.940408}, {1.3932},
>> {1.84599}, {2.29878}, {2.75156}, {3.18113},
>> {3.65714}, {4.12154}, {4.59755}, {5.03873},
>> {5.49152}, {5.92109}, {6.42032}, {6.90794},
>> {7.39556}, {7.87156}, {8.34757}, {8.82358},
>> {9.3112}, {9.79882}, {10.3445}, {10.983},
>> {11.5751}, {12.2369}, {12.9683}, {13.6882},
>> {14.4312}, {15.1859}, {15.9637}, {16.7416},
>> {17.5543}}}];
>>
>> len = Length[data];
>>
>> c = Interpolation[data];
>>
>> data2 = Flatten[{
>> {0.03566}, {0.53600}, {0.84040}, {.99870},
>> {1.3257}, {1.5655}, {1.6757}, {3.5789}}]
>>
>> {0.03566, 0.536, 0.8404, 0.9987, 1.3257, 1.5655, 1.6757, 3.5789}
>>
>> Note that Flatten is required for each data set to remove the
>> extraneous list brackets that are around each of your data elements.
>>
>> pt[t_, k_, n_] = {
>> 1/c'[t]*Cos[2 Pi*t/n],
>> 1/c'[t]*Sin[2 Pi*t/n],
>> k*c[t]};
>>
>> Manipulate[Show[
>> ParametricPlot3D[pt[t, k, n], {t, 1, len}],
>> Graphics3D[{
>> AbsolutePointSize[6],
>> Red,
>> Point[pt[time, k, n]],
>> Blue,
>> Point[pt[
>> Rescale[#, {Min[data], Max[data]}, {1, 33}],
>> k, n] & /@ data2]}]],
>> {{n, 8, "beats per cycle"}, 2^Range[2, 4]},
>> {{k, 1/4, "height of cycle"}, 2^Range[-3, 0]},
>> {{time, len/2.}, 1, len, .1, Appearance -> "Labeled"}]
>>
>> Note that "time" slider above runs from 1 to 33 which correspond to
>> the numbering of the original 33 data points. If you want the
>> parametric "time" slider to correspond to the actual time values then
>> the time needs to be redefined and rescaled as below.
>>
>> Manipulate[Show[
>> ParametricPlot3D[pt[
>> Rescale[t, {Min[data], Max[data]}, {1, 33}],
>> k, n], {t, Min[data], Max[data]}],
>> Graphics3D[{
>> AbsolutePointSize[6],
>> Red,
>> Point[pt[Rescale[time, {Min[data], Max[data]}, {1, 33}], k, n]],
>> Blue,
>> Tooltip[Point[pt[
>> Rescale[#, {Min[data], Max[data]}, {1, 33}],
>> k, n]], #] & /@ data2}]],
>> {{n, 8, "beats per cycle"}, 2^Range[2, 4]},
>> {{k, 1/4, "height of cycle"}, 2^Range[-3, 0]},
>> {{time, Mean[data]}, Min[data], Max[data],
>> Appearance -> "Labeled"}]
>>
>>
>> Bob Hanlon
>>
>>
>> On Fri, Aug 24, 2012 at 8:11 PM, andrew mcgraw <mcgraw.andrew at gmail.com>
>> wrote:
>> > Dear Bob,
>> >
>> > I was wondering if I could pick your brain one more time. I am now
>> > trying to
>> > represent as points a 2nd set of arbitrary, non-periodic onsets onto the
>> > curve drawn by the first data set (below). That is, the z axis
>> > (representing
>> > time) would be supplied by the new array (representing a second musical
>> > layer), but the points' x/y would be defined by the curve drawn by the
>> > plot
>> > you describe below. Any suggestions would be very welcome.
>> >
>> > 2nd array: {0.03566}, {0.53600}, {0.84040}, {.99870},
>> > {1.3257}, {1.5655}, {1.6757}, {3.5789}
>> >
>> > Best!
>> > Andrew
>> >
>> >
>> > On Fri, Aug 17, 2012 at 2:50 PM, Bob Hanlon <hanlonr357 at gmail.com>
>> > wrote:
>> >>
>> >> My identification is
>> >>
>> >> Robert C. Hanlon, PhD
>> >> Col, USAF, Ret.
>> >> Clarksville, MD 21029, USA
>> >>
>> >> I have added a ColorFunction and a few other minor tweaks to the
>> >> ParametricPlot3D below.
>> >>
>> >> data = Flatten[{{
>> >> {0.0348299}, {0.476009}, {0.940408}, {1.3932},
>> >> {1.84599}, {2.29878}, {2.75156}, {3.18113},
>> >> {3.65714}, {4.12154}, {4.59755}, {5.03873},
>> >> {5.49152}, {5.92109}, {6.42032}, {6.90794},
>> >> {7.39556}, {7.87156}, {8.34757}, {8.82358},
>> >> {9.3112}, {9.79882}, {10.3445}, {10.983},
>> >> {11.5751}, {12.2369}, {12.9683}, {13.6882},
>> >> {14.4312}, {15.1859}, {15.9637}, {16.7416},
>> >> {17.5543}
>> >> }}];
>> >>
>> >> len = Length[data];
>> >>
>> >> c = Interpolation[data];
>> >>
>> >> pt[t_, k_, n_] = {
>> >> 1/c'[t]*Cos[2 Pi*t/n],
>> >> 1/c'[t]*Sin[2 Pi*t/n],
>> >> k* c[t]};
>> >>
>> >> Manipulate[
>> >> Show[
>> >> ParametricPlot3D[pt[t, k, n],
>> >> {t, 1, len},
>> >> PlotStyle -> Thick,
>> >> ColorFunction ->
>> >> Function[{x, y, z, t},
>> >> ColorData["DarkRainbow"][
>> >> Norm[{2 x - 1, 2 y - 1}]]]],
>> >> Graphics3D[{
>> >> Red,
>> >> AbsolutePointSize[8],
>> >> Point[pt[time, k, n]]}]],
>> >> {{n, 8, "beats per cycle (n)"},
>> >> 2^Range[2, 4]},
>> >> {{k, 1/4, "height of cycle (k)"},
>> >> 2^Range[-3, 0]},
>> >> {{time, len/2., "time (t)"}, 1, len, .1,
>> >> Appearance -> "Labeled"}]
>> >>
>> >>
>> >> Bob Hanlon
>> >>
>> >>
>> >> On Fri, Aug 17, 2012 at 9:00 AM, andrew mcgraw
>> >> <mcgraw.andrew at gmail.com>
>> >> wrote:
>> >> > Dear Mr. Hanlon,
>> >> >
>> >> > This is immensely helpful! How may I credit you in any presentations
>> >> > that
>> >> > might evolve from this?
>> >> >
>> >> > Take Care!
>> >> > AM
>> >> >
>> >> >
>> >> > On Fri, Aug 17, 2012 at 7:56 AM, Bob Hanlon <hanlonr357 at gmail.com>
>> >> > wrote:
>> >> >>
>> >> >> data = Flatten[{{
>> >> >> {0.0348299}, {0.476009}, {0.940408}, {1.3932},
>> >> >> {1.84599}, {2.29878}, {2.75156}, {3.18113},
>> >> >> {3.65714}, {4.12154}, {4.59755}, {5.03873},
>> >> >> {5.49152}, {5.92109}, {6.42032}, {6.90794},
>> >> >> {7.39556}, {7.87156}, {8.34757}, {8.82358},
>> >> >> {9.3112}, {9.79882}, {10.3445}, {10.983},
>> >> >> {11.5751}, {12.2369}, {12.9683}, {13.6882},
>> >> >> {14.4312}, {15.1859}, {15.9637}, {16.7416},
>> >> >> {17.5543}
>> >> >> }}];
>> >> >>
>> >> >> len = Length[data];
>> >> >>
>> >> >> c = Interpolation[data];
>> >> >>
>> >> >> Do not use capital letters as first (or only) letter for
>> >> >> user-defined
>> >> >> symbols. This will avoid conflicts with Mathematica's built-in
>> >> >> symbols
>> >> >> (e.g., N has a specific meaning).
>> >> >>
>> >> >> ?N
>> >> >>
>> >> >> N[expr] gives the numerical value of expr.
>> >> >> N[expr,n] attempts to give a result with n-digit precision. >>
>> >> >>
>> >> >> pt[t_, k_, n_] = {
>> >> >> 1/c'[t]*Cos[2 Pi*t/n],
>> >> >> 1/c'[t]*Sin[2 Pi*t/n],
>> >> >> k* c[t]};
>> >> >>
>> >> >> With[{n = 8, k = 1/4},
>> >> >> ParametricPlot3D[pt[t, k, n],
>> >> >> {t, 1, len}]]
>> >> >>
>> >> >> A dynamic version
>> >> >>
>> >> >> Manipulate[
>> >> >> Show[
>> >> >> ParametricPlot3D[pt[t, k, n],
>> >> >> {t, 1, len}],
>> >> >> Graphics3D[{
>> >> >> Red,
>> >> >> AbsolutePointSize[6],
>> >> >> Point[pt[time, k, n]]}]],
>> >> >> {{n, 8, "beats per cycle"}, 2^Range[2, 4]},
>> >> >> {{k, 1/4, "height of cycle"}, 2^Range[-3, 0]},
>> >> >> {{time, len/2.}, 1, len, .1, Appearance -> "Labeled"}]
>> >> >>
>> >> >>
>> >> >> Bob Hanlon
>> >> >>
>> >> >>
>> >> >> On Fri, Aug 17, 2012 at 3:47 AM, amcgraw <mcgraw.andrew at gmail.com>
>> >> >> wrote:
>> >> >> > Dear List,
>> >> >> >
>> >> >> > I'm a musicologist new to mathematica, hoping the readership will
>> >> >> > indulge my considerable ignorance for a moment. I'm trying to
>> >> >> > represent
>> >> >> > musical timings as points going around a helix. Each full
>> >> >> > revolution
>> >> >> > should
>> >> >> > include 8 beats (points) and the helix should "swell" with slower
>> >> >> > tempos
>> >> >> > (longer inter-onset intervals) and "compress" with faster tempos
>> >> >> > (shorter
>> >> >> > inter-onset intervals).
>> >> >> >
>> >> >> > Plotting this 2D is easy enough, but uninteresting.
>> >> >> >
>> >> >> > A colleague has suggested the following to graph this helix.
>> >> >> >
>> >> >> > C(t) counts # of beats elapsed at time t, then slope C'(t) =
>> >> >> > beats
>> >> >> > per
>> >> >> > minute at time t. Constants: K = vertical distance between cycles;
>> >> >> > N
>> >> >> > =
>> >> >> > number of beats in one cycle (here 8). Then the onsets are
>> >> >> > represented on
>> >> >> > the spiral using:
>> >> >> >
>> >> >> > x = (1/C'(t)) cos((2pi/N)t)
>> >> >> > y = (1/C'(t)) sin((2pi/N)t)
>> >> >> > z = KC(t)
>> >> >> >
>> >> >> > I'm wondering how the readership would go about realizing this
>> >> >> > within
>> >> >> > mathematica. Having just installed the program, I'm just now
>> >> >> > getting
>> >> >> > up to
>> >> >> > speed with basic importing and visualization of data, as well as
>> >> >> > playing
>> >> >> > with various ways to build and manipulate 3D graphics. Its
>> >> >> > bridging
>> >> >> > these
>> >> >> > two, in this example, that I'd greatly appreciate pointers on.
>> >> >> >
>> >> >> > Thank You!
>> >> >> > AM
>> >> >> >
>> >> >> > Sample timing data outlining 4 cycles of 8 beats, slowing down:
>> >> >> >
>> >> >> > {{{0.0348299}, {0.476009}, {0.940408}, {1.3932}, {1.84599},
>> >> >> > {2.29878}, {2.75156}, {3.18113}, {3.65714}, {4.12154}, {4.59755},
>> >> >> > {5.03873}, {5.49152}, {5.92109}, {6.42032}, {6.90794}, {7.39556},
>> >> >> > {7.87156}, {8.34757}, {8.82358}, {9.3112}, {9.79882}, {10.3445},
>> >> >> > {10.983}, {11.5751}, {12.2369}, {12.9683}, {13.6882}, {14.4312},
>> >> >> > {15.1859}, {15.9637}, {16.7416}, {17.5543}}}
>> >> >> >
>> >> >> >
>> >> >
>> >> >
>> >
>> >
>
>
- References:
- Representing musical timings on a helix
- From: amcgraw <mcgraw.andrew@gmail.com>
- Representing musical timings on a helix