Characteristics of Musical Modes in WolframTones: A Visualization

Timothy M. Walker

Ohio Dominican University

Modes and Scales in Music

Musical Scales

A musical scale can be defined as the set of notes (or pitch-classes) from which the melody is typically constructed.  There are 12 notes per octave in the chromatic scale, but most scales use only a subset of them, with the musical root (or “tonic”) being the starting point of the scale.  For example, a C-Major scale uses the notes C-D-E-F-G-A-B (the white notes on a piano) and not any of the (black key) sharps or flats.  The output below shows a schematic representation of the notes used in a Major scale:

ArrayPlot[{{1,0,1,0,1,1,0,1,0,1,0,1}},ImageSize->Large]

Enumeration

By considering each scale as a set of 12 Boolean values in which the first (the tonic) is always true, musical scales can be represented as a 12-bit binary number in the range 2048 - 4095.  For example, the Major scale shown above would be given the value 101011010101 = 2773.  All possible scales are visualized in the output below:

ArrayPlot[Map[IntegerDigits[#,2]&,Range[2048,4095]],ImageSize->Large,AspectRatio->4]

Musical Modes

However, many of the scalar patterns in the output above belong to groups that can be derived from one another by “rotating” the scale to start the root on a different scale degree.  For example, the notes A-B-C-D-E-F-G define an A-minor scale, but they are the same (white key) notes as C-Major with a different starting point.  So, the patterns 2773 (Major) and 2906 (Minor) belong to the same modal “family”, as shown in the output below:

Grid[{{ArrayPlot[{Join[2*IntegerDigits[2773,2],IntegerDigits[2773,2]]},ImageSize->Large],"Major scale #2773 (repeated)"},{ArrayPlot[{PadRight[PadLeft[IntegerDigits[2906,2],21],24]},ImageSize->Large],"minor scale #2906"}},Alignment->{Left,Baseline}]

There are in fact 7 different modes in the family derived from the 2773 Major scale, obtained by using each of the scale degrees as a root.

playScale[id_Integer,root_Integer]:=Sound[Map[SoundNote[#,0.5]&,Select[Append[IntegerDigits[id,2],1]*Range[13],#>0&]+root-1]]

playScale[2773,0]
playScale[2906,9]
playScale[2906,0]

ArrayPlot[{IntegerDigits[2730,2]},ImageSize->Large]
playScale[2730,0]

Scale definitions in WolframTones

WolframTones allows users complete flexibility in defining a custom scale (http://tones.wolfram.com/generate/advanced.html?pitch), so the log files from the WolframTones website contain a wealth of data regarding the acceptability of various tonal sets.  The web logs were filtered to identify the scale IDs associated with melodies that users downloaded; the assumption being that those melodies were judged to be of good aesthetic quality.

Parsing the data

The data

The raw data consists of decimal equivalents of scale patterns in the WolframTones log files.

Sort[Union[data]]

Scales with known names

namedScales=ToExpression/@{3926,2477,2937,3156,3456,2772,2184,3248,3285,2322,2418,3510,2964,3062,2422,2930,2934,3872,2386,3442,2419,2504,2896,2634,3799,4092,3934,3676,2515,4064,4032,2972,2510,3257,3305,3700,3301,3385,3698,2675,4088,4080,3968,3805,2507,3740,3840,3584,4094,2336,2925,2340,2775,2706,2902,2910,2918,2836,3392,3290,3428,2729,2704,2911,3549,2805,2640,2130,2261,3292,2870,3449,2648,2777,2905,3286,2848,3929,2837,2840,3426,3038,2517,2486,2765,3170,3376,2901,3414,2942,3154,2724,3434,2921,3436,3430,3424,2741,2733,2869,2709,2746,2736,2485,2453,3501,2773,2781,2716,2192,3289,2794,2778,3039,2768,2708,2049,2052,2752,2176,3291,3558,3253,3386,2739,2489,3260,3379,3673,2521,3388,3283,3642,3641,2908,2490,2748,2745,3669,2780,2771,3258,3638,2867,3637,2522,3635,2483,3674,3411,3382,3644,2874,3420,2492,3381,2876,3667,3670,2899,3251,2524,3822,3003,3900,2535,3640,2275,3770,2795,4030,3055,3380,3276,2457,3120,2145,2600,2210,2906,2388,3030,2966,2320,2873,2898,2922,3063,2050,2056,2304,2816,2774,2790,2646,2258,2766,3547,3413,3417,3756,3387,2669,3302,3680,2742,3352,2064,2112,3418,3930,3482,2394,3450,2880,3328,3435,2726,3238,2916,2884,2865,2888,2886,3225,2514,3317,2628,3370,2649,2245,2712,2180,2737,3636,2374,2377,2373,3368,3400,2878,3097,2641,2137,3256,2228,2800,2257,3410,3281,3153,2889,2630,3369,2705,3237,2757,2346,2632,3244,2213,3250,2618,2402,3157,2355,2234,3228,3164,3284,2266,3354,2246,2262,2392,3145,3593,2721,2134,2713,3144,2358,2263,2194,3288,2611,2225,3222,2378,2197,3218,2838,3249,2260,2390,2582,3272,3265,2643,2903,2452,2725,2353,3632,2645,2769,2385,2650,2860,2693,2209,2613,2096,3161,2783,2265,3162,2633,2133,3596,2758,2759,3031,3321,2853,2481,3158,2629,3224,3270,3346,3350,2354,2761,2614,2268,2128,3128,3293,2330,2612,2597,2866,4059,2897,2770,3273,2647,2900,3660,3416,2593,2872,2393,2259,2842,2609,2198,3274,3269,2868,3633,2227,3401,2230,2740,2264,3402,2518,2249,3254,2970,3160,2114,2644,3220,3072,3509,3562,3520,3546,3498,2642,3835,2807,2857,2858,2080,4095,3500,2048,2306,2907,3307,3243,3275,2818,2560,2730,2731,2720,2688,3830,2909};

Counting and grouping the data

Length[data]

Union[data]//Length  (* Shows the number of unique scales in the logs *)

degreeFreq=Total[IntegerDigits[data,2]]

Data manipulation

Functions and variables for formatting data

Function that takes an integer scale ID (e.g., 2773) and outputs a list with all of its rotated equivalents (e.g., {2773,2774,2741,...}):

findModes[scale_]:=Module[{i,list={scale},bin=IntegerDigits[scale,2]},
For[i=1,i<Total[bin],i++,bin=RotateLeft[bin];While[bin[[1]]==0,bin=RotateLeft[bin]];AppendTo[list,FromDigits[bin,2]]];
Return[Union[list]]]

Function that compares two equivalent modes and returns the chromatic location that the first mode’s root would need to rotate to in order to equal the second mode:

fromRoot[j_Integer,k_Integer]:=Module[{i=0,ref=IntegerDigits[j,2],comp=IntegerDigits[k,2]},
While[(ref≠comp)&&(i<Length[ref]),i++;comp=RotateLeft[comp]];
If[i<Length[ref],Return[i+1],Return[0]]]

uniqueScaleCounts=Tally[data];
equivScaleCounts =GatherBy[uniqueScaleCounts,findModes[#[[1]]]&] ; (* Groups together modal families *)
sortedEquivScaleCounts = SortBy[Map[SortBy[#,Last]&,equivScaleCounts],#[[-1,1]]&];  (* Sorts each group by frequency, and then puts scales in numerical order *)
ordered = Map[Reverse,sortedEquivScaleCounts];

Function that lists the first member of each group along with the total frequency for all members in that group:

getMax[part_]:=Return[{part[[1,1]],Total[part[[All,2]]]}]

max = Map[getMax,ordered];  (* Uses the most frequent mode of a family to represent the entire family *)
mostFrequent = Reverse[SortBy[max,#[[2]]&]];

Function that repeats the scale ID by its frequency:

equivScales[list_List]:=Module[{h={}},Map[For[i=0,i<#[[2]],i++,AppendTo[h,#[[1]]]]&,list];Return[h]]

tallyEquiv = Partition[Riffle[IntegerDigits[Range[2048,4096],2],BinCounts[equivScales[mostFrequent],{2048,4096,1}]],2];
(* Gets all possible scales in binary form along with the frequency of each family representative *)
more6modes=Union[Flatten[Select[findModes/@Range[2048,4095],Length[#]>6&]]];
more6distinct=Select[more6modes,Total[IntegerDigits[#,2]]==Length[findModes[#]]&];
more6OrNot=Map[If[MemberQ[more6distinct,#],2*IntegerDigits[#,2],IntegerDigits[#,2]]&,Range[2048,4096]];
(* Marks the scales containing at least 7 modes within the space of all possible scales by using 2 instead of 1 *)
namedOrNot=Map[If[MemberQ[namedScales,#],2*IntegerDigits[#,2],IntegerDigits[#,2]]&,Range[2048,4096]];
(* Marks the named scales within the space of all possible scales by using 2 instead of 1 *)
scalesIntLessM3=Select[Range[2048,4095],Max[Length/@Take[Split[IntegerDigits[#,2]],{2,-1,2}]]≤3&];
(* All possible scales whose largest interval is a Major Third or smaller *)
P5andLessM3=Pick[scalesIntLessM3,BitGet[scalesIntLessM3,4],1];
(* All possible scales from above which additionally contain the Perfect Fifth *)
wellOrNot=Map[If[MemberQ[P5andLessM3,#],2*IntegerDigits[#,2],IntegerDigits[#,2]]&,Range[2048,4096]];
(* Marks the "well-formed" scales (defined above) within the space of all possible scales by using 2 instead of 1 *)
tallyAll=Partition[Riffle[IntegerDigits[Range[2048, 4096],2],BinCounts[data,{2048, 4096, 1}]],2];
(* Each individual scale in the data represented in binary form along with its frequency count *)
splitIndiv=Partition[Map[#[[1]]*#[[2]]&,tallyAll],128];
(* Individual scales partitioned and marked by frequency in order to display on graph *)
splitEquivs=Partition[Map[#[[1]]*#[[2]]&,tallyEquiv],128];
(* Family representatives partitioned and marked by frequency in order to display on graph *)

Function that uses fromRoot to map the frequencies within a modal family to a single modal representation.  The root position gets the frequency of its mode, the next position gets the frequency of the mode with that position as root, etc. (e.g., {278,0,0,134,0,120,78,0,0,150,0,130} from the representative mode {1,0,0,1,0,1,1,0,0,1,0,1} with frequency 278, {1,0,1,1,0,0,1,0,1,1,0,0} with frequency 134, ...):

wrapModalFreq[l_List]:=ReplacePart[IntegerDigits[l[[1,1]],2],MapThread[#1->#2&,{Map[fromRoot[#,l[[1,1]]]&,l[[All,1]]],l[[All,2]]}]]

Function that puts data into triplets in the form of {{1,1,int},{1,1,int2},...} for the sector chart syntax:

rawSectorSet[intList_List]:=Module[{z={}},For[i=1,i<13,i++,AppendTo[z,{1,1,intList[[i]]+1}];If[i==12,Return[z]]]]

Same as above except takes the log of the data, so {{1,1,Log[int]},{1,1,Log[int2]},...}:

logSectorSet[intList_List]:=Module[{z={}},For[i=1,i<13,i++,AppendTo[z,{1,1,N@Log[intList[[i]]+2]}];If[i==12,Return[z]]]]

sectorData=wrapModalFreq/@sortedEquivScaleCounts;
rawFreqSectorData = rawSectorSet/@sectorData;
logFreqSectorData = logSectorSet/@sectorData;
grpNums=Map[Last,Map[SortBy[#,Last]&,sortedEquivScaleCounts]][[All,1]];
(* Gets most frequent scale ID from each modal family in same order as in sortedEquivScaleCounts *)

Circular mode charts

Frequency of each scale degree appearing in the logs

SectorChart3D[rawSectorSet[degreeFreq],SectorOrigin->{Automatic,1},ColorFunction->Function[{angle,radius,height},ColorData["RedGreenSplit"][height]]]

ArrayPlot[{degreeFreq}]

Modal Frequency, selectable by the Scale ID of the Family Representative

Each scale degree is shown in yellow, with the height representing the number of times it was chosen as the root

Manipulate[SectorChart3D[rawFreqSectorData[[c]],SectorOrigin->{Automatic,1},ColorFunctionScaling->False,ColorFunction->Function[{angle,radius,height},If[height>1,CMYKColor[0,.16,1,.20],Black]]
],{{c,103,"Group ID"},MapThread[#1->#2&,{Range[Length@logFreqSectorData],grpNums}]}]

Modal Families, selectable by Scale ID

All modes from a given scale' s family are shown

Manipulate[Grid[{Map[Graphics[SectorChart3D[logSectorSet[IntegerDigits[#,2]+IntegerDigits[2048,2]],SectorOrigin->{Automatic,1},ColorFunction->Function[{angle,radius,height},ColorData["SunsetColors"][height]]]]&,findModes[x]],ArrayPlot/@Partition[IntegerDigits[findModes[x],2],1],findModes[x]}],{{x,2773,"Group ID"},Union@data}]

Graphs of scale spaces

What are characteristics of scales that users might prefer?

Scales with several distinct modes

There are 1005 scales which belong to families containing 7 or more modes

BarChart[Length/@findModes/@Range[2048,4095],ImageSize->Large]

Well - Formed Scales

Two simple musical heuristics to define “well-formed” scales:

The scale should contain the "Perfect Fifth", which is the note whose frequency ratio with respect to the tonic is 3 : 2, the simplest integer ratio of frequencies other than the octave.

The scale should not contain large pitch intervals, defined by a distance of no more than a Major Third, or 4 semitones.

Applying these two heuristics results in a subset of 840 scales, shown in the figure below.

Common or established scales

There are 404 established scales with names stored in the WolframTones site

Overlay with family representatives (yellow) plus other individual scales (red).

Comparison of chosen scales to scales with at least 7 modes or the well - formed rules or the set of named scales.
The frequency in the log files determines the opacity

Manipulate[Overlay[{Row[Map[ArrayPlot[#,PixelConstrained->3,ColorRules->{1->RGBColor[0.5,0.5,0.5],2->RGBColor[0,0,0]}]&,Partition[comparison,128]],Spacer[1.5]],If[indiv,Row[Map[ArrayPlot[#,PixelConstrained->3,ColorFunction->Function[{a},Directive[Red,Opacity[a]]]]&,Log[splitIndiv+1]],Spacer[1.5]]],If[rep,Row[Map[ArrayPlot[#,PixelConstrained->3,ColorFunction->Function[{a},Directive[Yellow,Opacity[a]]]]&,Log[splitEquivs+1]],Spacer[1.5]]]}],{{comparison,more6OrNot,"Comparison Subset"},{more6OrNot->"At Least 7 Modes",wellOrNot->"Well-Formed",namedOrNot->"Named Scales"}},{{indiv,True,"Individual Scales"},{True,False}},{{rep,True,"Family Representatives"},{True,False}}]

Some Simple Counts

Count[Map[MemberQ[namedScales,#]&,data],True]
Count[Map[MemberQ[namedScales,#]&,data],False]
Count[Map[MemberQ[P5andLessM3,#]&,data],True]
Count[Map[MemberQ[more6modes,#]&,data],True]

Complement[namedScales,P5andLessM3]//Length

custom=Select[data,Not[MemberQ[namedScales,#]]&];
Count[Map[MemberQ[P5andLessM3,#]&,custom],True]
Count[Map[MemberQ[more6modes,#]&,custom],True]

Acknowledgements

Special Thanks To:

Brian Cooper
Sean Whalen
Paul - Jean Letourneau
Todd Rowland
Stephen Wolfram
Everyone at the Pisa NKS Summer School