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