Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- VisualiseSequence[l_, highlight_: False] := Graphics[{
- If[highlight, {Yellow, Disk[{0, 0}, 1.4]}, {}],
- Circle[],
- Table[{p = {Sin[ Pi (i - 1)/2], Cos[Pi ( i - 1) /2]};
- Lighter@({Red, Orange, Green, Blue}[[l[[i]]]]), Disk[p, 0.3],
- Black, Text[Style[l[[i]], Medium], p]
- }, {i, 4}]
- }];
- ValidTransition[p1_, p2_] := (p1 != p2) &&
- Not@(Or @@
- Map[# > 1 &,
- Abs[Flatten@Table[Position[p1, n], {n, p2}] -
- Range@Length@p1]]);
- Vertices = Permutations[Range[4]];
- AllEdges = Tuples[Vertices, 2];
- Edges = DeleteDuplicates[
- Map[#[[1]] -> #[[2]] &,
- Select[AllEdges,
- ValidTransition[#[[1]], #[[2]]] &]], (#1 == #2 ||
- Reverse@#1 == #2) &];
- Needs["GraphUtilities`"];
- path = First[HamiltonianCycles[Edges]];
- pathedges = Transpose[{path, RotateRight[path]}];
- SongVis[n_] :=
- GraphPlot[Edges,
- VertexRenderingFunction -> (Inset[
- VisualiseSequence[#2, #2 == path[[n]]], #1, {0, 0}, 0.6] &),
- EdgeRenderingFunction -> (If[
- MemberQ[pathedges, #2] ||
- MemberQ[pathedges, Reverse[#2]], {Red, Thickness[.01],
- Line[#1]}, {Black, Line[#1]}] &)
- ];
- Manipulate[SongVis[n], {n, 1, 24, 1}]
- (* and play it*)
- startTs =
- Accumulate[
- Table[0.3 + RandomReal[NormalDistribution[0, 0.1]], {i, 96}]];
- Bell[n_, m_] := Module[{note = {"C", "D", "F", "G"}[[n]]},
- SoundNote[{note}, {startTs[[m]], startTs[[m]] + 1},
- "TubularBells"]
- ];
- Sound[Map[Bell @@ # &, Transpose[{Flatten[path], Range[96]}], {1}]]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement