<< DiscreteMath`Combinatorica`

Off[General::"spell1"];
f0 = 440. ;
nharm = 20;
sr = 1000. *Pi;
rd1 := Random[Real, {- .5,  .5}]
rd2 := Random[Real, {0, 1.8}]
tauSude = 5;
kASude = 0.2;
tauLiche = 7;
KALiche = 0.2;
pLayrAnge = 5;
sude1[i_] := 
        kASude*0.5*(1 - (((-1))^i))*
          Exp[((-i*tauSude)/nharm)];
S1 = Prepend[sude1 /@ Range[nharm], 1];
liche1[i_] := 
        KALiche*0.5*(1 + (((-1))^i))*
          Exp[((-i*tauLiche)/nharm)];
L1 = Prepend[liche1 /@ Range[nharm], 1];
ListPlot[S1, PlotStyle -> {PointSize[0.02]}, 
        PlotRange -> All];
ListPlot[L1, PlotStyle -> {PointSize[0.02]}, 
        PlotRange -> All];

tonL[k_, t_] = (Sin[k*f0*2*Pi*#*t] & /@ Range[nharm + 1]) . 
          L1;
tonS[k_, t_] = (Sin[k*f0*2*Pi*#*t] & /@ Range[nharm + 1]) . 
          S1;

pyth1 = {1, (2187/2048), (9/8), (32/27), (81/64), (4/3), (729/512), (3/2), 
          (128/81), (27/16), (16/9), (243/128), 2};
temper = 
        Table[(((2. ^i))^(1/12)), {i, 0, 12}];
fPyth[k_Integer] := 
        1. *pyth1[[k]] /; 
          1 ≤ k ≤ 12;
fPyth[k_Integer] := 
        2. *fPyth[k - 12] /; k > 12;
fPyth[k_Integer] := 
        0.5*fPyth[k + 12] /; k < 1;
fTemper[k_Integer] := 
        1. *temper[[k]] /; 
          1 ≤ k ≤ 12;
fTemper[k_Integer] := 
        2. *fTemper[k - 12] /; k > 12;
fTemper[k_Integer] := 0.5*fTemper[k + 12] /; k < 1;

naj[list_, nb_] := 
        Module[{konec, zacatek}, konec = Take[list, nb]; 
          zacatek = Take[list, -nb]; 
          Norm[zacatek - konec]/nb];
mfce[{list_, n_, odch_}] := {list, n + 1, 
          naj[list, n]};
m2fce[list_] := 
      Module[{n}, 
        n = NestWhile[mfce, {list, 1, 1}, 
              Abs[Last[#]] > (10^(-2)) &][[-2]]; 
        Join[list, Take[list, {n, Length[list]}]]]
fceprot[list_, doba_] := 
        Module[{length, pom}, length = Round[doba*sr*1. ]; 
          pom = NestWhile[m2fce, list, Length[#] < length &]; 
          Take[pom, length]];

k0 = -56;
\(\(Print["f do k01= ", k0, "   ", 
        f0*fPyth[
            k0], \ " a odpovidajici perioda T= ", \((f0*fPyth[k0])\)\^\(-1\), " s"];\)\)
k01 = 70;
\(Print["f do k01= ", k01, "   ", 
      f0*fPyth[k01], \ " a odpovidajici perioda T= ", \((f0*fPyth[k01])\)\^\(-1\), " s"]\)
fPyth /@ Table[k, {k, k0, k01}];
fTemper /@ Table[k, {k, k0, k01}];
ListPlot[% - %%, PlotStyle -> {PointSize[0.015]}, 
        PlotRange -> All];
aK[k_] := 
        0.01 + Exp[((3. *(k0 - k))/((k01 - k0)))];
Plot[aK[k], {k, k0, k01}, 
        PlotRange -> {Automatic, {0, 1}}];

PsampleS[k_] := 
        Module[{f, T, t, tau}, f = f0*fPyth[k0]; T = (1. /f); tau = (1. /sr); 
          Table[tonS[fPyth[k], t], {t, 0, 1.05  T, 
              tau}]];
PsampleL[k_] := 
        Module[{f, T, t, tau}, f = f0*fPyth[k0]; T = (1. /f); tau = (1. /sr); 
          Table[tonL[fPyth[k], t], {t, 0, 1.05  T, tau}]];
PtonyS = Table[aK[k]*PsampleS[k], {k, k0, k01}];
PtonyL = Table[aK[k]*PsampleL[k], {k, k0, k01}];
ListPlot[PtonyS[[10]], PlotStyle -> {PointSize[0.01]}, 
        PlotRange -> All];

TsampleS[k_] := 
        Module[{f, T, t, tau}, f = f0*fTemper[k0]; T = (1. /f); tau = (1. /sr); 
          Table[tonS[fTemper[k], t], {t, 0, 1.05  T, 
              tau}]];
TsampleL[k_] := 
        Module[{f, T, t, tau}, f = f0*fTemper[k0]; T = (1. /f); tau = (1. /sr); 
          Table[tonL[fTemper[k], t], {t, 0, 1.05  T, tau}]];
TtonyS = Table[aK[k]*TsampleS[k], {k, k0, k01}];
TtonyL = Table[aK[k]*TsampleL[k], {k, k0, k01}];
NullTony = 0. *Range[100];

zahraj[cohraj_] := 
        EmitSound[
          ListPlay[cohraj, SampleRate -> sr, 
            PlayRange -> {-1.  pLayrAnge, 
                1.  pLayrAnge}]];
PCohrajL[{k_, a_, long_}] := 
        If[k0 ≤ k ≤ k01, 
          fceprot[a*PtonyL[[k - k0 + 1]], long], 
          fceprot[NullTony, long]];
PCohrajS[{k_, a_, long_}] := 
        If[k0 ≤ k ≤ k01, 
          fceprot[a*PtonyS[[k - k0 + 1]], long], 
          fceprot[NullTony, long]];
PCohraj[co_] := 
        PCohrajS[co] + PCohrajL[co];
TCohrajL[{k_, a_, long_}] := 
        If[k0 ≤ k ≤ k01, 
          fceprot[a*TtonyL[[k - k0 + 1]], long], 
          fceprot[NullTony, long]];
TCohrajS[{k_, a_, long_}] := 
        If[k0 ≤ k ≤ k01, 
          fceprot[a*TtonyS[[k - k0 + 1]], long], 
          fceprot[NullTony, long]];
TCohraj[co_] := 
        TCohrajS[co] + TCohrajL[co];

ktry = -10;
ListPlot[TCohraj[{ktry, 1, 1}]];
ListPlot[
        TCohraj[{ktry, 1, 1}] + 
          PCohraj[{ktry, 1, 
              1}]];

ClearAll[rejstrik1];
rejstrik1[{zakl_, rej_, interval_}, co : {k_, a_, long_}] := 
        Module[{fzakl, frej, ki, ai}, 
          fzakl[ki_, ai_] := zakl[{ki, ai, long}]; 
          frej[ki_, ai_] := rej[{ki, ai, long}]; 
          fzakl[k, a] + frej[k + 12 + interval, a] + 
            frej[k + 24 + interval, a*0.5] + frej[k + 36 + interval, a*0.5] + 
            frej[k + 48 + interval, a*0.2]];
kvinta[{k_, long_}] := 
        rejstrik1[{TCohrajS, PCohrajS, 8}, {k, 1, 
            long}];
ListPlot[kvinta[{-20,  .2}]];

ClearAll[melodie, f, kk, omez];
omez[k_] := 
      Module[{makacka, gen, i, imin, imax, tonyztoniny}, 
        makacka = {1, 3, 5, 6, 8, 10, 12}; gen[i_] := makacka + i*12; 
        imin = Round[(k0/12)]; imax = Round[(k01/12) - 1]; 
        tonyztoniny = 
          Flatten[Table[gen[i], {i, imin, imax}]]; Sort[
            Table[{Abs[k - tonyztoniny[[i]]], tonyztoniny[[i]]}, {i, 
                Length[tonyztoniny]}]][[1, 
            2]]]
osminka = (1. /64);
takt = 3;
ntaktu = 10;
nmax = ntaktu*takt*2;
fmel[{n_, a_, b_, c_, d_, sh_}, {offset_, rozsah_}] := 
        Module[{t, kk, p}, kk = 24. *(Pi/nmax); t = n; 
          p = 12*(Sin[kk*t + sh] + 0.56 + Sin[0.2  kk*t]) + 
              a*Sin[b*kk*t] + c*Sin[d*Pi*Sin[0.2*kk*(Sqrt[t])]*kk*t]; 
          omez[p*rozsah + offset]];
mymel1[n_] := 
      fmel[{n, 1,  .8785, 2.7, 0.5, 0}, {2, 0.5}]
rnv = {0, Random[],  .8785*Random[], Random[] + 2.7, 0, 
          Pi};
mymel2[n_] := 
      fmel[{n, 1,  .8785, 2.7, 0.5, 0} + rnv, {2, 
          0.5}]
Plot[{mymel2[n], mymel1[n]}, {n, 0, nmax}, 
        PlotStyle -> {Hue[0], 
            Hue[0.63]}];

zakltaktycaste = {{2, 2, 2}, {2, 1, 1, 2}, {2, 1, 1, 1, 1}, {1, 1, 2, 
            2}, {1, 1, 1, 1, 2}, {1, 1, 2, 1, 
            1}};
nzt = Length[zakltaktycaste];
takt := 
        Part[zakltaktycaste, 
          Random[Integer, {1, nzt}]];
ftakt[{n_, takty_}] := {n + 1, 
          Join[takty, takt]};
delky1 = 
        NestWhile[
            ftakt, {1, {2, 2, 2}}, #[[1]] ≤ 
                ntaktu - 1 &] /. {a_, b_} :> 
            b;
delky2 = 
        NestWhile[
            ftakt, {1, {2, 1, 1, 2}}, #[[1]] ≤ 
                ntaktu - 1 &] /. {a_, b_} :> 
            b;
ClearAll[tn]
tn1[1] = delky1[[1]];
tn1[n_] := tn1[n] = 
          tn1[n - 1] + delky1[[n]];
tn2[1] = delky1[[1]];
tn2[n_] := tn2[n] = 
          tn2[n - 1] + delky2[[n]];
dm1 = {mymel1[tn1[#]], delky1[[#]]} & /@ 
          Range[Length[delky1]];
dm2 = {mymel2[tn2[#]], delky2[[#]]} & /@ 
          Range[Length[delky2]];