Skip to content

Instantly share code, notes, and snippets.

@mnebes
Created December 9, 2022 14:03
Embed
What would you like to do?
Chord progressions with F#
open System
type Interval =
| PerfectUnison
| MinorSecond
| MajorSecond
| MinorThird | AugmentedSecond // Enharmonically the same in 12TET
| MajorThird
| PerfectFourth
| DiminishedFifth | AugmentedFourth // Enharmonically the same in 12TET
| PerfectFifth
| MinorSixth | AugmentedFifth // Enharmonically the same in 12TET
| MajorSixth | DiminishedSeventh // Enharmonically the same in 12TET
| MinorSeventh
| MajorSeventh
| Octave
| OctaveUp of Interval
type Note =
| C
| CsDb
| D
| DsEb
| E
| F
| FsGb
| G
| GsAb
| A
| AsBb
| B
let chromaticBase = [ C; CsDb; D; DsEb; E; F; FsGb; G; GsAb; A; AsBb; B ]
let tones = Seq.initInfinite (fun i -> chromaticBase[i % chromaticBase.Length])
module Interval =
let rec inSemitones interval =
match interval with
| PerfectUnison -> 0
| MinorSecond -> 1
| MajorSecond -> 2
| AugmentedSecond
| MinorThird -> 3
| MajorThird -> 4
| PerfectFourth -> 5
| AugmentedFourth
| DiminishedFifth -> 6
| PerfectFifth -> 7
| AugmentedFifth
| MinorSixth -> 8
| MajorSixth
| DiminishedSeventh -> 9
| MinorSeventh -> 10
| MajorSeventh -> 11
| Octave -> 12
| OctaveUp interval -> 12 + inSemitones interval
let rec fromSemitones =
function
| 0 -> PerfectUnison
| 1 -> MinorSecond
| 2 -> MajorSecond
| 3 -> MinorThird
| 4 -> MajorThird
| 5 -> PerfectFourth
| 6 -> DiminishedFifth
| 7 -> PerfectFifth
| 8 -> MinorSixth
| 9 -> MajorSixth
| 10 -> MinorSeventh
| 11 -> MajorSeventh
| 12 -> Octave
| x when x > 12 -> fromSemitones (x - 12)
| _ -> failwith "Can't map this"
type Chord =
{ Root: Note; IntervalsFromRoot: Interval list }
module Chord =
let getNotes chord =
let indexOfRoot = Seq.findIndex (fun note -> note = chord.Root) tones
let intervals =
List.map Interval.inSemitones chord.IntervalsFromRoot
|> List.sort
[ chord.Root, 0
for interval in intervals do
// this is just lazy, one almost never goes over 2 octaves..
let octaveInfo = if interval > 12 - indexOfRoot then 1 else 0
Seq.item (indexOfRoot + interval) tones, octaveInfo ]
module Triads =
let major root = { Root = root; IntervalsFromRoot = [MajorThird; PerfectFifth] }
let minor root = { Root = root; IntervalsFromRoot = [MinorThird; PerfectFifth] }
let diminished root = { Root = root; IntervalsFromRoot = [MinorThird; DiminishedFifth] }
let augmented root = { Root = root; IntervalsFromRoot = [MajorThird; AugmentedFifth] }
module Modifications =
let with6b chord = { chord with IntervalsFromRoot = MinorSixth :: chord.IntervalsFromRoot }
let with6 chord = { chord with IntervalsFromRoot = MajorSixth :: chord.IntervalsFromRoot }
let withMinor7 chord = { chord with IntervalsFromRoot = MinorSeventh :: chord.IntervalsFromRoot }
let withMajor7 chord = { chord with IntervalsFromRoot = MajorSeventh :: chord.IntervalsFromRoot }
let withDiminished7 chord = { chord with IntervalsFromRoot = DiminishedSeventh :: chord.IntervalsFromRoot }
let with9b chord = { chord with IntervalsFromRoot = OctaveUp(MinorSecond) :: chord.IntervalsFromRoot }
let with9 chord = { chord with IntervalsFromRoot = OctaveUp(MajorSecond) :: chord.IntervalsFromRoot }
let with9s chord = { chord with IntervalsFromRoot = OctaveUp(AugmentedSecond) :: chord.IntervalsFromRoot }
let with11 chord = { chord with IntervalsFromRoot = OctaveUp(PerfectFourth) :: chord.IntervalsFromRoot }
let with13b chord = { chord with IntervalsFromRoot = OctaveUp(MinorSixth) :: chord.IntervalsFromRoot }
let with13 chord = { chord with IntervalsFromRoot = OctaveUp(MajorSixth) :: chord.IntervalsFromRoot }
module TetraChords =
open Modifications
let seventh = Triads.major >> withMinor7
let minorSeventh = Triads.minor >> withMinor7
let majorSeventh = Triads.major >> withMajor7
let halfDiminished = Triads.diminished >> withMinor7
let diminished = Triads.diminished >> withDiminished7
let minorMajorSeventh = Triads.minor >> withMajor7
module MiscChords =
open Modifications
let power root = { Root = root; IntervalsFromRoot = [PerfectFifth; Octave] }
let suspended4 root = { Root = root; IntervalsFromRoot = [PerfectFourth; PerfectFifth] }
let eleventh = TetraChords.seventh >> with11
let add11 = Triads.major >> with11
type Scale = int list
module Scales =
let private rotate steps list =
List.splitAt steps list |> fun (x,y)-> List.append y x
let major = [2; 2; 1; 2; 2; 2; 1]
let harmonicMinor = [2; 1; 2; 2; 1; 3; 1]
let melodicMinor = [2; 1; 2; 2; 2; 2; 1]
module Modes =
let ionian = major
let dorian = rotate 1 major
let phrygian = rotate 2 major
let lydian = rotate 3 major
let mixolydian = rotate 4 major
let aeolian = rotate 5 major
let locrian = rotate 6 major
let minor = Modes.aeolian
let getNotes key (scale: Scale) =
let indexOfRoot = Seq.findIndex (fun note -> note = key) tones
let _, notes = List.fold (fun (interval, notes) value -> interval+value, Seq.item (indexOfRoot + interval + value) tones :: notes) (0,[key]) scale
List.rev (List.tail notes)
let getNotesWithIntervals key (scale: Scale) =
let indexOfRoot = Seq.findIndex (fun note -> note = key) tones
let _, notes =
List.fold
(fun (interval, notes) value -> interval+value, (Seq.item (indexOfRoot + interval + value) tones, value) :: notes)
(0,[key, scale[indexOfRoot]])
scale
List.rev (List.tail notes)
let getSemitonesToRoot scale =
let _, intervals = List.fold (fun (interval, intervals) value -> interval+value, (interval + value) :: intervals) (0,[0]) scale
List.rev (List.tail intervals)
type HarmonicFunction =
| I // Tonic
| II // Super-Tonic
| III // Mediant
| IV // Sub-Dominant
| V // Dominant
| VI // Sub-Mediant
| VII // Leading tone
module Harmony =
// type Progression =
// { Key: Note
// Scale: Scale
// Chords: HarmonicFunction list }
let mapToScaleIndex =
function
| I -> 0
| II -> 1
| III -> 2
| IV -> 3
| V -> 4
| VI -> 5
| VII -> 6
let private infinite (scale: _ list) = Seq.initInfinite (fun i -> scale[i % scale.Length])
let buildTetrachord key scale harmonicFunction =
let scaleNotes = Scales.getNotesWithIntervals key scale |> infinite
let indexOfKey = Seq.findIndex (fun (note, _) -> note = key) scaleNotes
let indexOfChordRoot = indexOfKey + (mapToScaleIndex harmonicFunction)
let rootNote, _ = Seq.item indexOfChordRoot scaleNotes
let rec getChordNotes start index totalInterval notes =
if List.length notes >= 4 then
notes
else
let note, interval = Seq.item (start + index) scaleNotes
let semitonesFromRoot = totalInterval + interval
printfn $"{note} {interval} {totalInterval}"
if index % 2 = 0 then
getChordNotes start (index + 1) semitonesFromRoot ((note, semitonesFromRoot) :: notes)
else
getChordNotes start (index + 1) semitonesFromRoot notes
let chordNotes = getChordNotes indexOfChordRoot 1 0 [ rootNote, 0 ] |> List.rev
printfn "%A" chordNotes
match chordNotes with
| (root, _) :: rest ->
{ Root = root
IntervalsFromRoot =
[ for (_ ,interval) in rest do
Interval.fromSemitones interval ]}
| _ -> failwith ""
let buildTetrachordProgression key scale progression =
progression
|> List.map (buildTetrachord key scale)
module SonicPi =
let baseOctave = 4
let toSonicPiNote (note, octaveDiff) =
match note with
| C -> "C"
| CsDb -> "Cs"
| D -> "D"
| DsEb -> "Ds"
| E -> "E"
| F -> "F"
| FsGb -> "Fs"
| G -> "G"
| GsAb -> "Gs"
| A -> "A"
| AsBb -> "As"
| B -> "B"
|> fun n -> sprintf ":%s%i" n (baseOctave + octaveDiff)
let printChord chord =
Chord.getNotes chord
|> List.map toSonicPiNote
|> fun notes -> $"play [{String.Join(',', notes)}]"
let printChordProgression stepDuration chords =
chords
|> List.map printChord
|> List.map (fun chord -> $"{chord}, release: {stepDuration}{Environment.NewLine}sleep {stepDuration}")
|> fun chords -> String.Join(Environment.NewLine, chords)
let fSharp7sharp9 = TetraChords.seventh FsGb |> Modifications.with9s
Chord.getNotes fSharp7sharp9
SonicPi.printChord fSharp7sharp9
Scales.getNotes FsGb Scales.minor
let ``F#m`` = Triads.minor FsGb
Scales.getSemitonesToRoot Scales.minor |> List.map Interval.fromSemitones
Scales.getNotesWithIntervals D Scales.major
Harmony.buildTetrachord D Scales.major I
let one_four_five = Harmony.buildTetrachordProgression D Scales.major [I; IV; V; I]
let one_two_five = Harmony.buildTetrachordProgression D Scales.major [I; II; V; I]
let one_five_six_four = Harmony.buildTetrachordProgression D Scales.major [I; V; VI; IV]
let ``I-IV-V-I`` = Harmony.buildTetrachordProgression FsGb Scales.major [I; IV; V; I]
``I-IV-V-I``
|> SonicPi.printChordProgression 2
|> printfn "%s"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment