kraehenbuehl harmonizing algorithm

gistfile1.clj

(ns kraehenbuehl.core
  (:require [leipzig.scale :as scale]
            [leipzig.chord :refer [root triad inversion]]
            [overtone.music.pitch :refer [find-note-name]]))

;eg. (kraehenbuehl (comp scale/G scale/major) [62 64 62 60 59])
;=> ((43 55 59 62) (52 55 59 64) (47 54 59 62) (38 54 57 60) (43 50 55 59))

(declare pitch-class)
(declare triad-with-top)

(defn kraehenbuehl
  "Given a leipzig scale function (key) and vec of midi pitches,
  return a random four-part harmony generated by the Kraenhenbuehl
  method (Knuth, 2011). Final chord may be unresolved."
  [key pitches]
  (let [leading-tone (pitch-class (key -1))
        inversions (flatten (iterate shuffle [0 1 2]))]
    (map
     (fn [pitch inversion]
       (let [triad (triad-with-top pitch inversion key)
             notes (map key (vals triad))
             ; transpose triad root down an octave
             bass-note (-> triad :i key (- 12))
             bass-note (if (not= leading-tone (pitch-class bass-note))
                         bass-note
                         ; correct leading tone to dominant tone
                         (last (drop-last 2 (take-while #(<= % bass-note) (map key (range -100 100))))))]
         (cons bass-note (sort notes))))
     pitches
     inversions)))

(defn pitch-class   
  "Given a pitch in SPN or midi number, return pitch class.
   eg. (pitch-class :Db4) ;=> 'Db'
       (pitch-class 'A4') ;=> 'A'
       (pitch-class 73)   ;=> 'C#'"
  [pitch]
  (if (number? pitch)
    (pitch-class (find-note-name pitch))
    (second (re-find #"(\D*)(\d*)" (name pitch)))))

(defn triad-with-top
  "Given a pitch ('top'), return the triad in the given key
  (inv'th inversion) having 'top' as its top note."
  [top inv key]
  (first (filter #(= top (apply max (map key (vals %))))
                 (map #(-> triad (root %) (inversion inv))
                      (range -100 100)))))