Random Walk Demonstrations: More Technical Details

I did not implement the algorithm described (due to Aldous and Broder) for making the large spanning trees, but a faster one due to Wilson. The code was


tree[l_List,seed_]:=Module[{n=Length[l],r={1},ptr=Range[Length[l]],c,t,f},
   SeedRandom[seed];Do[If[Not[MemberQ[r,s]],c=s;
      While[Not[MemberQ[r,c]],t=RandomChoice[l[[c]]];ptr[[c]]=t;c=t]];f=s;
         While[Not[MemberQ[r,f]],AppendTo[r,f];f=ptr[[f]]],{s,2,n}];ptr]
makeedges[p_List]:=Table[{i,p[[i]]},{i,2,Length[p]}]

This took an adjacency list l of a graph as input, where the i-th list in l is the list of neighbors of vertex number i. Applying makeedges to the result of tree gives a list of edges of a uniform spanning tree.

Since Hue is cyclic, it is good for coloring the Peano-like curve, but I find that there's too much of [0,1] devoted to indistinguishable colors, so I used the following instead:


myhue[x_]:=Hue[Interpolation[{{0,0},{1,1},{.1,.12},{.2,.15},{.4,.3},{.5,.45},{.55,.5},{.7,.6},{.77,.72},{.9,.85}}][Mod[x,1]]]

You can see this coding via


Show[Graphics[Flatten[Table[{myhue[i/100],Rectangle[{i-.5,0},{i+.5,8}]},{i,0,99}]]],Axes->True]

To make the fade-in title, I made a graphic, title, as I wanted, took the first frame I wanted, widestartframe, and made functions out of each that varied the Opacity. (For the eps frames, I varied the intensity of the color instead.) They were combined as follows:


fadein=Join[ConstantArray[title,75],
   Table[Show[Graphics[Join[optitle[1-x],opaqstart[x]],Background->Black,PlotRange->{(4/3)*{-9,10},{-9,10}}]],{x,0,1,1/75}],
      ConstantArray[widestartframe,75]];

Note that the graphics need to be created in the aspect ratio 4/3, so that the result would not be distorted by later external conversions. The result can be checked internally via


ListAnimate[fadein, 25]

I used 25 frames per second since the music went by 1/5 sec per note.

To make a list of notes for Lilypond, I used the following (for better engraving, I grouped identical successive 1/16th notes depending on their place in the beat and in the measure):


ascale={"a","b","cis","d","e","fis","gis"};
lily[i_(*coordinate*),qp_(*place in quarter note, 1-4*),t_(*duration*),loc_(*location in measure, 1-16*)]:=
   Module[{note=ascale[[Mod[i+1,7,1]]],rem},
      If[t>0&&loc>0,DeleteCases[Flatten[
         If[qp>1,{Switch[Min[t,5-qp],1,note<>"16~",2,note<>"8~",3,note<>"8.~"],lily[i,1,t-Min[t,5-qp],Mod[loc+Min[t,5-qp],16,1]]},
         rem=Min[t,17-loc]; Which[rem==1,{note<>"16~"},rem==2,{note<>"8~"},rem==3,{note<>"8.~"},
               4<=rem<8,{note<>"4~",lily[i,1,t-4,Mod[loc+4,16,1]]},
               8<=rem<12,{note<>"2~",lily[i,1,t-8,Mod[loc+8,16,1]]},
               12<=rem<16,{note<>"2.~",lily[i,1,t-12,Mod[loc+12,16,1]]},
               rem>=16,{note<>"1~",lily[i,1,t-16,loc]}]]],""],{""}]]
               (*0 is A and a tie is ignored to a different note, so I can always add a tie*)

lily[l_List]:=Module[{o={},s,n=l[[1]],c,i=1,loc},While[i<=Length[l],s=n;c=0;loc=i;
   While[s==n&&i<=Length[l],c++;If[i<Length[l],n=l[[i+1]]];i++];AppendTo[o,lily[s,Mod[loc,4,1],c,Mod[loc,16,1]]]];Flatten[o]]

Once I had the Peano-like curve as a list, pc, of edges, I then exported the x- and y-coordinates separately:


lily[Join[pc[[All,1,1]],ConstantArray[0,12]]]

The end result, after a little editing, was this file.

Unfortunately, neither Mathematica nor Lilypond can output Midi in stereo (neither can handle panning). This is why I used Midge for the Midi. To output the notes in Midge format, I used these commands (in order to avoid repeating identical successive notes, I grouped them into longer notes):


ascale={"c+","d","e","f+","g+","a","b"};
group[l_List]:=Module[{o={},s,n=l[[1]],c,i=1},While[i<=Length[l],s=n;c=0;
   While[s==n&&i<=Length[l],c++;If[i<Length[l],n=l[[i+1]]];i++];AppendTo[o,{s,c}]];o]
any[i_]:=Module[{c,s},c=Mod[i-1,7,1];s=Quotient[i-1,7,1];StringJoin[ascale[[c]],ToString[s+5]]]
note[{i_,t_}]:=StringJoin["/L",ToString[t],":16/",any[i]]
pcg1=group[Join[pc[[All,1,1]],ConstantArray[0,12]]];
pcg2=group[Join[pc[[All,1,2]],ConstantArray[0,12]]];
Export["peanoLmg.txt",note/@pcg1]
Export["peanoRmg.txt",note/@pcg2]

The end result, after a little editing, was this file.