Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2012

[Date Index] [Thread Index] [Author Index]

Search the Archive

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



  • Prev by Date: Re: How Expand?
  • Next by Date: Re: Mathematica issue
  • Previous by thread: Re: Representing musical timings on a helix
  • Next by thread: Inconsistent behavior of RegionFunction in ContourPlot and ListContourPlot