This post is part of the F# Advent Calendar in English 2015 project. Check out all the other great posts there! And special thanks to Sergey Tihon for organizing this.

Hi something fun and not too technical for end the year !

As everyone knows, the favorite instrument of Santa Claus is Ukulele ! So let's play some music, and especialy some Ukulele !

First thing first, let's create functions for notes. We start with C at octave 0, and have a progression by half tones.

So C is 0, D is 2, E is 4.

Since there is only a half tone between E and F, F is 5.

F is 7, A is 9, B is 11, and we reach next octave at 12, which is C 1 :

1: 2: 3: 4: 5: 6: 7: 8: 9: open System let C n = 12 * n let D n = C n + 2 let E n = C n + 4 let F n = C n + 5 let G n = C n + 7 let A n = C n + 9 let B n = C n + 11

For sharps and flat, lets define two functions that had and remove a half tone

1: 2: let sharp n = n + 1 let flat n = n - 1

We can now create names for each note :

1: 2: 3: 4: 5: 6: 7: 8: 9: 10: let Cd = C > > sharp let Db = D > > flat let Dd = D > > sharp let Eb = E > > flat let Fd = F > > sharp let Gb = G > > flat let Gd = G > > sharp let Ab = A > > flat let Ad = A > > sharp let Bb = B > > flat

There is no E sharp or F flat because it is F and E respectively, same thing for B and C...

Will create a structure with a custome comparison/equality that doesn't take the octave into account by using a 12 modulus, this will prove usefull to work with chords:

1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: [< Struct >] [< CustomComparison >] [< CustomEquality >] [< StructuredFormatDisplay ( "{Display}" ) >] type Note ( note : int ) = member __ . Note = note override __ . GetHashCode ( ) = note % 12 override __ . Equals other = match other with | :? Note as other -> note % 12 = other . Note % 12 | _ -> false static member names = [| "C" "C#" "D" "D#" "E" "F" "F#" "G" "G#" "A" "A#" "B" |] member __ . Display = let name = Note . names . [ note % 12 ] let octave = note / 12 sprintf " %s %d " name octave override this . ToString ( ) = this . Display interface IEquatable < Note > with member __ . Equals other = note % 12 = other . Note % 12 interface IComparable < Note > with member __ . CompareTo other = compare ( note % 12 ) ( other . Note % 12 ) interface IComparable with member __ . CompareTo other = match other with | :? Note as other -> compare ( note % 12 ) ( other . Note % 12 ) | _ -> 1 static member ( + ) ( string : Note , fret : int ) = Note ( string . Note + fret ) let notes = List . map Note

Ukulele Strings

A Ukulele has 4 strings.

The funy thing is that the 1st one is higher than the second one, where on most string instruments strings are in progressive order.

This is simply due to the limited size of the Ukulele, a low first string would not sound good, so it is adjusted to the next octave.

This gives use the following:

1: let strings = notes [ G 4 ; C 4 ; E 4 ; A 4 ]

Chords

Instead of hard-encoding ukulele chords, we will compute them !

So a bit of theory about chords.

Chords are defined by their root note and the chord quality (major, minor).

The chords start on the root note, and the chord quality indicates the distance to other notes to include in the chord.

On string instrument, the order and the height of the actual notes are not really important for the chord to be ok. So we can use a note at any octave.

Now, let's define the chord qualities.

First, Major, uses the root note, 3rd and 5th, for instance for C, it will be C, E, G, which gives intervals of 0, 4 and 7 half tones from root.

1: 2: 3: let quality = notes > > Set . ofList let M n = quality [ n ; n + 4 ; n + 7 ]

Then, Minor, uses the root note, the lower 3rd and 5th. For C it will be C, E flat, G, so intervals of 0, 3 and 7 half tones for root.

1: let m n = quality [ n ; n + 3 ; n + 7 ]

The 7th adds a 4th note on the Major:

1: let M7 n = quality [ n ; n + 4 ; n + 7 ; n + 11 ]

Frets

As on a gitare, a ukulele has frets, places where you press the string with your finger to change the tone of a string.

0 usually represent when you don't press a string at all, and pinching the string will play the string note.

When pressing fret 1, the note is one half tone higher, fret 2, two half tone (or one tone) higher.

So pressing the second fret on the C 4 string give a D 4.

Our first function will try pressing on frets to find frets for notes that belong to the chord

1: 2: 3: 4: 5: let findFrets chord ( string : Note ) = [ 0.. 10 ] |> List . filter ( fun fret -> Set . contains ( string + fret ) chord ) |> List . map ( fun fret -> fret , string + fret )

The result is list of pair, (fret, note) that can be used on the strnig

The second function will explore the combinaison of frets/note and keep only those that contains all notes of the chords.

Ex: for a C Major chord, we need at least a C, a E and a G.

using frets 0 on string G, 0 on string C, 3 on string E, and 3 on string A, we get G, C, G, C.

All notes are part of the chord, but there is no E... not enough. 0,0,0,3 is a better solution.

The function explore all possible solution by checking notes on string that belong to the chord, and each time remove a note from the chord. At the end, there should be no missing note.

At each level sub solutions are sorted by a cost. Standard Ukulele chords try to place fingers as close to the top as possible. So lewer frets are better.

The cost function for a chords is to sum square of frets. If there is any solution, we keep the one with the lowest cost.

1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: let rec filterChord chord missingNotes solution stringFrets = match stringFrets with | [ ] -> if Set . isEmpty missingNotes then Some ( List . rev solution ) else None | string :: tail -> string |> List . filter ( fun ( _ , note ) -> chord |> Set . contains note ) |> List . choose ( fun ( fret , note ) -> filterChord chord ( Set . remove note missingNotes ) ( ( fret , note ) :: solution ) tail ) |> List . sortBy ( fun s -> List . sumBy ( fun ( fret , _ ) -> fret * fret ) s ) |> List . tryHead

making a cord is now simple.

Compute the note in the chord using quality and root.

For each string, map possible frets the belong to the chord, then filter it.

1: 2: 3: 4: 5: 6: 7: let chord root quality = let chord = quality ( root 4 ) strings |> List . map ( findFrets chord ) |> filterChord chord chord [ ] |> Option . get

We can now try with classic chords:

1: let CM = chord C M

and the result is:

[(0, G 4); (0, C 4); (0, E 4); (3, C 5)]

Now C minor:

1: let Cm = chord C m

which is exactly what you can find on a tab sheet:

[(0, G 4); (3, D# 4); (3, G 4); (3, C 5)]

1: 2: 3: 4: 5: 6: 7: chord D m chord A M chord A m chord G m chord E M

Printing chords

To print chords, we will simply use pretty unicode chars, and place a small 'o' on the fret where we should place fingers:

1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: let print chord = let fret n frt = if n = frt then "o" else "│" let line chord n = chord |> List . map ( fst > > fret n ) |> String . concat "" printfn "┬┬┬┬" [ 1.. 4 ] |> List . map ( line chord ) |> String . concat "

┼┼┼┼

" |> printfn " %s "

Let's try it

1: chord C M |> print

It prints

┬┬┬┬ ││││ ┼┼┼┼ ││││ ┼┼┼┼ │││o ┼┼┼┼ ││││

Another one

1: chord G M |> print

and we get

┬┬┬┬ ││││ ┼┼┼┼ │o│o ┼┼┼┼ ││o│ ┼┼┼┼ ││││

Playing chords

We can also play chords using NAudio.

You can find NAudio on nuget.org

For simplicity I will use the midi synthetizer:

1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: #r @"../packages\NAudio\lib

et35\NAudio.dll" open NAudio . Midi let device = new MidiOut ( 0 ) MidiOut . DeviceInfo 0 let midi ( m : MidiMessage ) = device . Send m . RawData let startNote note volume = MidiMessage . StartNote ( note , volume , 2 ) |> midi let stopNote note volume = MidiMessage . StopNote ( note , volume , 2 ) |> midi let sleep n = System . Threading . Thread . Sleep ( n : int )

Now we can define a function that will play a chord.

The tempo is used as a multiplicator for a the chord length.

Longer tempo means slower.

For better result we introduce an arpegio, a small delay between each note. Don't forget to remove this time from the waiting length...

The direction indicate if the cords are strumed Up, or Down. In the Up case we reverse the chord.

1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: type Direction = Dn of int | Up of int let play tempo arpegio ( chord , strum ) = let strings , length = match strum with | Dn length -> chord , length | Up length -> List . rev chord , length strings |> List . iter ( fun ( _ , ( n : Note ) ) -> startNote n . Note 100 ; sleep arpegio ) let arpegioLength = List . length chord * arpegio sleep ( length * tempo - arpegioLength ) strings |> List . iter ( fun ( _ , ( n : Note ) ) -> stopNote n . Note 100 )

To strum a chord, we give a list of length, and a chord, and it will apply the cord to each length:

1: 2: 3: 4: 5: 6: let strum strm chord = let repeatedChord = strm |> List . map ( fun _ -> chord ) List . zip repeatedChord strm

Now here is Santa Clause favorite song, Get Lucky by Daft Punk.

First the chords :

1: 2: 3: 4: 5: 6: 7: 8: 9: let luckyChords = [ //Like the legend of the Phoenix, chord B m // All ends with beginnings. chord D M // What keeps the planets spinning, chord ( Fd ) m // The force from the beginning. chord E M ]

Then strum, this is the rythm used to play the same chord, it goes like, Dam, Dam, Dam Dala Dam Dam:

1: 2: let luckyStrum = [ Dn 4 ; Dn 3 ; Dn 2 ; Dn 1 ; Up 2 ; Dn 2 ; Up 2 ]

and the full song :

1: 2: 3: let getLucky = luckyChords |> List . collect ( strum luckyStrum )

And now, let's play it :

1: 2: 3: 4: getLucky |> List . replicate 2 |> List . concat |> List . iter ( play 130 25 )

And the tab notations for the song !

1: 2: luckyChords |> List . iter print

┬┬┬┬ ││││ ┼┼┼┼ │ooo ┼┼┼┼ ││││ ┼┼┼┼ o│││ ┬┬┬┬ ││││ ┼┼┼┼ ooo│ ┼┼┼┼ ││││ ┼┼┼┼ ││││ ┬┬┬┬ │o││ ┼┼┼┼ o│o│ ┼┼┼┼ ││││ ┼┼┼┼ ││││ ┬┬┬┬ o│││ ┼┼┼┼ │││o ┼┼┼┼ ││││ ┼┼┼┼ │o││

Conclusion

I hope this small thing was entertaining and that it'll get you into ukulele !

For excercise you can:

implements more chords

Better printing

add more liveliness and groove by adding some jitter to the strum...

add the lyrics for Karaoke !

try with other songs !

try the same for a 6 string gitar !

Now it's your turn to rock !

namespace System

val C : n:int -> int

val n : int

val D : n:int -> int

val E : n:int -> int

val F : n:int -> int

val G : n:int -> int

val A : n:int -> int

val B : n:int -> int

val sharp : n:int -> int

val flat : n:int -> int

val Cd : (int -> int)

val Db : (int -> int)

val Dd : (int -> int)

val Eb : (int -> int)

val Fd : (int -> int)

val Gb : (int -> int)

val Gd : (int -> int)

val Ab : (int -> int)

val Ad : (int -> int)

val Bb : (int -> int)

Multiple items

type StructAttribute =

inherit Attribute

new : unit -> StructAttribute



--------------------

new : unit -> StructAttribute

Multiple items

type CustomComparisonAttribute =

inherit Attribute

new : unit -> CustomComparisonAttribute



--------------------

new : unit -> CustomComparisonAttribute

Multiple items

type CustomEqualityAttribute =

inherit Attribute

new : unit -> CustomEqualityAttribute



--------------------

new : unit -> CustomEqualityAttribute

Multiple items

type StructuredFormatDisplayAttribute =

inherit Attribute

new : value:string -> StructuredFormatDisplayAttribute

member Value : string



--------------------

new : value:string -> StructuredFormatDisplayAttribute

Multiple items

type Note =

struct

interface IComparable

interface IComparable<Note>

interface IEquatable<Note>

new : note:int -> Note

override Equals : other:obj -> bool

override GetHashCode : unit -> int

override ToString : unit -> string

member Display : string

member Note : int

static member names : string []

...

end



--------------------

Note ()

new : note:int -> Note

val note : int

Multiple items

val int : value:'T -> int (requires member op_Explicit)



--------------------

type int = int32



--------------------

type int<'Measure> = int

val __ : inref<Note>

val other : obj

val other : Note

property Note.Note: int with get

val name : string

property Note.names: string [] with get

val octave : int

val sprintf : format:Printf.StringFormat<'T> -> 'T

val this : inref<Note>

type IEquatable<'T> =

member Equals : other:'T -> bool

Multiple items

type IComparable =

member CompareTo : obj:obj -> int



--------------------

type IComparable<'T> =

member CompareTo : other:'T -> int

val compare : e1:'T -> e2:'T -> int (requires comparison)

Multiple items

val string : Note



--------------------

type string = String

val fret : int

val notes : (int list -> Note list)

Multiple items

module List



from Microsoft.FSharp.Collections



--------------------

type List<'T> =

| ( [] )

| ( :: ) of Head: 'T * Tail: 'T list

interface IReadOnlyList<'T>

interface IReadOnlyCollection<'T>

interface IEnumerable

interface IEnumerable<'T>

member GetReverseIndex : rank:int * offset:int -> int

member GetSlice : startIndex:int option * endIndex:int option -> 'T list

member Head : 'T

member IsEmpty : bool

member Item : index:int -> 'T with get

member Length : int

...

val map : mapping:('T -> 'U) -> list:'T list -> 'U list

val strings : Note list

val quality : (int list -> Set<Note>)

Multiple items

module Set



from Microsoft.FSharp.Collections



--------------------

type Set<'T (requires comparison)> =

interface IReadOnlyCollection<'T>

interface IComparable

interface IEnumerable

interface IEnumerable<'T>

interface ICollection<'T>

new : elements:seq<'T> -> Set<'T>

member Add : value:'T -> Set<'T>

member Contains : value:'T -> bool

override Equals : obj -> bool

member IsProperSubsetOf : otherSet:Set<'T> -> bool

...



--------------------

new : elements:seq<'T> -> Set<'T>

val ofList : elements:'T list -> Set<'T> (requires comparison)

val M : n:int -> Set<Note>

val m : n:int -> Set<Note>

val M7 : n:int -> Set<Note>

val findFrets : chord:Set<Note> -> string:Note -> (int * Note) list

val chord : Set<Note>

val filter : predicate:('T -> bool) -> list:'T list -> 'T list

val contains : element:'T -> set:Set<'T> -> bool (requires comparison)

val filterChord : chord:Set<'a> -> missingNotes:Set<'a> -> solution:(int * 'a) list -> stringFrets:(int * 'a) list list -> (int * 'a) list option (requires comparison)

val chord : Set<'a> (requires comparison)

val missingNotes : Set<'a> (requires comparison)

val solution : (int * 'a) list (requires comparison)

val stringFrets : (int * 'a) list list (requires comparison)

val isEmpty : set:Set<'T> -> bool (requires comparison)

union case Option.Some: Value: 'T -> Option<'T>

val rev : list:'T list -> 'T list

union case Option.None: Option<'T>

Multiple items

val string : (int * 'a) list (requires comparison)



--------------------

type string = String

val tail : (int * 'a) list list (requires comparison)

val note : 'a (requires comparison)

val choose : chooser:('T -> 'U option) -> list:'T list -> 'U list

val remove : value:'T -> set:Set<'T> -> Set<'T> (requires comparison)

val sortBy : projection:('T -> 'Key) -> list:'T list -> 'T list (requires comparison)

val s : (int * 'a) list (requires comparison)

val sumBy : projection:('T -> 'U) -> list:'T list -> 'U (requires member ( + ) and member get_Zero)

val tryHead : list:'T list -> 'T option

val chord : root:(int -> 'a) -> quality:('a -> Set<Note>) -> (int * Note) list

val root : (int -> 'a)

val quality : ('a -> Set<Note>)

module Option



from Microsoft.FSharp.Core

val get : option:'T option -> 'T

val CM : (int * Note) list

val Cm : (int * Note) list

val print : chord:(int * 'a) list -> unit

val chord : (int * 'a) list

val fret : ('b -> 'b -> string) (requires equality)

val n : 'b (requires equality)

val frt : 'b (requires equality)

val line : (('b * 'c) list -> 'b -> string) (requires equality)

val chord : ('b * 'c) list (requires equality)

val fst : tuple:('T1 * 'T2) -> 'T1

Multiple items

type String =

new : value:char[] -> string + 8 overloads

member Chars : int -> char

member Clone : unit -> obj

member CompareTo : value:obj -> int + 1 overload

member Contains : value:string -> bool + 3 overloads

member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit

member EndsWith : value:string -> bool + 3 overloads

member EnumerateRunes : unit -> StringRuneEnumerator

member Equals : obj:obj -> bool + 2 overloads

member GetEnumerator : unit -> CharEnumerator

...



--------------------

String(value: char []) : String

String(value: nativeptr<char>) : String

String(value: nativeptr<sbyte>) : String

String(value: ReadOnlySpan<char>) : String

String(c: char, count: int) : String

String(value: char [], startIndex: int, length: int) : String

String(value: nativeptr<char>, startIndex: int, length: int) : String

String(value: nativeptr<sbyte>, startIndex: int, length: int) : String

String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: Text.Encoding) : String

val concat : sep:string -> strings:seq<string> -> string

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

namespace NAudio

namespace NAudio.Midi

val device : MidiOut

Multiple items

type MidiOut =

new : deviceNo:int -> MidiOut

member Close : unit -> unit

member Dispose : unit -> unit

member Reset : unit -> unit

member Send : message:int -> unit

member SendBuffer : byteBuffer:byte[] -> unit

member SendDriverMessage : message:int * param1:int * param2:int -> unit

member Volume : int with get, set

static member DeviceInfo : midiOutDeviceNumber:int -> MidiOutCapabilities

static member NumberOfDevices : int



--------------------

MidiOut(deviceNo: int) : MidiOut

MidiOut.DeviceInfo(midiOutDeviceNumber: int) : MidiOutCapabilities

val midi : m:MidiMessage -> unit

val m : MidiMessage

Multiple items

type MidiMessage =

new : rawData:int -> MidiMessage + 1 overload

member RawData : int

static member ChangeControl : controller:int * value:int * channel:int -> MidiMessage

static member ChangePatch : patch:int * channel:int -> MidiMessage

static member StartNote : note:int * volume:int * channel:int -> MidiMessage

static member StopNote : note:int * volume:int * channel:int -> MidiMessage



--------------------

MidiMessage(rawData: int) : MidiMessage

MidiMessage(status: int, data1: int, data2: int) : MidiMessage

MidiOut.Send(message: int) : unit

property MidiMessage.RawData: int with get

val startNote : note:int -> volume:int -> unit

val volume : int

MidiMessage.StartNote(note: int, volume: int, channel: int) : MidiMessage

val stopNote : note:int -> volume:int -> unit

MidiMessage.StopNote(note: int, volume: int, channel: int) : MidiMessage

val sleep : n:int -> unit

namespace System.Threading

Multiple items

type Thread =

inherit CriticalFinalizerObject

new : start:ThreadStart -> Thread + 3 overloads

member Abort : unit -> unit + 1 overload

member ApartmentState : ApartmentState with get, set

member CurrentCulture : CultureInfo with get, set

member CurrentUICulture : CultureInfo with get, set

member DisableComObjectEagerCleanup : unit -> unit

member ExecutionContext : ExecutionContext

member GetApartmentState : unit -> ApartmentState

member GetCompressedStack : unit -> CompressedStack

member GetHashCode : unit -> int

...



--------------------

Threading.Thread(start: Threading.ThreadStart) : Threading.Thread

Threading.Thread(start: Threading.ParameterizedThreadStart) : Threading.Thread

Threading.Thread(start: Threading.ThreadStart, maxStackSize: int) : Threading.Thread

Threading.Thread(start: Threading.ParameterizedThreadStart, maxStackSize: int) : Threading.Thread

Threading.Thread.Sleep(timeout: TimeSpan) : unit

Threading.Thread.Sleep(millisecondsTimeout: int) : unit

type Direction =

| Dn of int

| Up of int

union case Direction.Dn: int -> Direction

union case Direction.Up: int -> Direction

val play : tempo:int -> arpegio:int -> chord:('a * Note) list * strum:Direction -> unit

val tempo : int

val arpegio : int

val chord : ('a * Note) list

val strum : Direction

val strings : ('a * Note) list

val length : int

val iter : action:('T -> unit) -> list:'T list -> unit

val n : Note

val arpegioLength : int

val length : list:'T list -> int

val strum : strm:'a list -> chord:'b -> ('b * 'a) list

val strm : 'a list

val chord : 'b

val repeatedChord : 'b list

val zip : list1:'T1 list -> list2:'T2 list -> ('T1 * 'T2) list

val luckyChords : (int * Note) list list

val luckyStrum : Direction list

val getLucky : ((int * Note) list * Direction) list

val collect : mapping:('T -> 'U list) -> list:'T list -> 'U list

val replicate : count:int -> initial:'T -> 'T list

val concat : lists:seq<'T list> -> 'T list