Microtonal / Just intonation experiments in Lisp

microtonal-1.lisp

;;;; Fun with Lisp: Just-intonation and Microtonality.
;;;;   If you're interested in Lisp, audio/music hacking, just-intonation or
;;;;   microtonality, then this is the sort of thing you're interested in.

;;;; (C) Copyright 2012 Andy Hefner <ahefner@gmail.com>

;;;; This code is released in the public domain.

;;; First, we'll need a way to play audio. In the past, I dumped the
;;; raw audio out to a file in /tmp and played it by shelling out to
;;; SoX. These days I can just play it out of an array in memory using
;;; Mixalot.

(defparameter *mixer* (mixalot:create-mixer))

(defgeneric play (this))

(defun normalize (vector)
  (let ((rescale (/ (reduce #'max vector :key #'abs :initial-value 0.0d0))))
    (map-into vector (lambda (x) (* x rescale 0.8d0)) vector)))

(defmethod play ((this vector))
  (mixalot:mixer-add-streamer
   *mixer*
   (mixalot:make-vector-streamer-mono-double-float
    (normalize this))))

;;; Next, synthesis - we'll need some audio to play. I'll define a
;;; function of frequency called TONE that produces a buffer of audio.

;;; I've reinvented this class of wheels enough times now, you'd think
;;; I'd do a better job of it.

(defparameter *len* 1 "Note length")

(deftype buffer () '(simple-array double-float 1))
(defun make-buffer (size) (make-array size :element-type 'double-float :adjustable nil :fill-pointer nil))

;;; Generate an audible tone.
(defun tone (freq &key (duration 40000) (len *len*))
  (declare (optimize (speed 3)))
  (loop with nsamples = (round (* duration len))
        with output = (the buffer (make-buffer nsamples))
        with decay-rate = (expt 0.07 1/65000)
        with omega = (float (/ (* freq 2.0d0 pi) 44100.0d0) 0.0d0)
        for amp of-type double-float = 1.0d0 then (* amp decay-rate)
        for phase of-type double-float = 0.0d0 then (+ phase omega)
        for n from 0 below nsamples
        do (setf (aref output n)
                 (* amp
                    ;; A simple FM (PM) oscillator. Tweaking the magic
                    ;; numbers produces a variety of mostly chime-like
                    ;; timbres.
                    (sin (+ phase (* 1.5 (expt amp 2) (sin (* phase 5)))))))
        finally (return output)))

;;; Music:

;;; I'll define a simple language for constructing musical phrases
;;; from the output of TONE function. There are two fundamental
;;; building blocks:

;;; 1. Sequencing of events serially in time:
(defun seq (&rest args) (apply #'concatenate 'buffer args))
;;; ..of which repetition is a special case:
(defun repeat (n &rest args) (apply #'seq (mapcan #'copy-list (loop repeat n collect args))))

;;; 2. Events in parallel:
(defun para (&rest args)                ; Faster, more useful:
  (reduce (lambda (out in) (declare (type buffer out in)) (map-into out #'+ out in))
          args :initial-value (make-buffer (reduce #'max args :key #'length))))

;;; Originally I wrote a simpler definition:
;;;   (defun para (&rest args) (apply #'map '(simple-array double-float 1) #'+ args))

;;; This defintion has the drawback of truncating the output length to
;;; that of the shortest component.  Also, using SBCL, it's much
;;; slower.  (apply #'map ...)  is a hairy expression that defied
;;; optimization by the compiler, whereas it can inline the map-into
;;; operation. Combined with the type declaration, that expands to a
;;; nice fast addition loop.

;;; Here's some syntactic sugar to make the pieces fit together more
;;; nicely, and print some useful output to the REPL:

(defmacro chord (properties &body body) `(let ,properties (print :chord) (para ,@body)))

(defparameter *tonic* 261.0d0)          ; Middle C.

(defmacro just (numerators denominators &rest args)
  `(progn
     ;; It's useful to see the both reduced fraction and its decimal representation:
     (print (list ',numerators ',denominators
                  (* ,@numerators (/ 1 ,@denominators))
                  (float (* ,@numerators (/ 1 ,@denominators)))))
     (tone (* *tonic* ,@numerators (/ 1 ,@denominators)) ,@args)))

;;; The #+HUSH conditionals are here so that this doesn't play a loud
;;; distorted racket when you compile the file. My workflow is to load
;;; this up in Emacs/SLIME and hit slime-compile-defun inside
;;; whichever expression I want to hear.

;;; First test: start with a major chord, invert the intervals each
;;; way we can, then resolve down to an inversion of the original
;;; chord. Note the two different senses of "invert".
#+HUSH
(play
 (seq
  (chord ()
   (just (1) (1))                       ; Root
   (just (5) (4))                       ; Major 3rd - 5:4
   (just (3) (2)))                      ; Fifth - 3:2
  (chord ()
   (just (1) (1))
   (just (4) (5))                       ; 5:4 becomes 4:5 - The major 3rd is reflected about the octave.
   (just (3) (2)))
  (chord ()
   (just (1) (1))
   (just (5) (4))
   (just (2) (3)))                      ; This time, the fifth.
  (chord ()
   (just (1) (1))
   (just (4) (5))                       ; - Now both are reflected.
   (just (2) (3)))                      ; -
  (chord ()                             ; Resolve down..
   (just (1) (1))
   (just (5) (4 2))
   (just (3) (2 2)))))

;;; Here's a pair of chords from one of Partch's caterwauls (see http://en.wikipedia.org/wiki/Tonality_flux):
#+HUSH
(let ((*tonic* 196.0)
      (*len* 3))
 (play
  (repeat 2
   (seq
    (chord ()
     (just (8)  (7))
     (just (10) (7))
     (just (12) (7)))
    (chord ()
     (just (7) (6))
     (just (7) (5))
     (just (7) (4)))))))

;;; See what he did there? The major chord, built starting 8/7 above
;;; the tonic, is reflected around the octave.  I find it clearer to
;;; consider the minor chord first, built upon an interval of 7/6
;;; above the tonic, then interpret the major as as built
;;; symmetrically downward from the next octave.

;;; It's clearer after rewriting the fractions without simplification
;;; to separate the 8:7 and octave copmonents from the intervals of
;;; the chord.
#+HUSH
(let ((*tonic* 196.0)
      (*len* 3))
 (play
  (repeat 2
   (seq
    (chord ()
     (just   (8 1) (1 7))               ;  8/7
     (just   (8 5) (4 7))               ; 10/7
     (just   (8 3) (2 7)))              ; 12/7
    (chord ()
     (just (2 7 1) (1 8 1))             ; 7/4, i.e. (2*7*1)/(1*8*1), if it isn't clear.
     (just (2 7 4) (5 8 1))             ; 7/5
     (just (2 7 2) (3 8 1)))))))        ; 7/6

;;; Applying that construction under equal temperament, the middle
;;; notes of the chords would be the same. Since this is just-intoned,
;;; the frequencies differ by about a third of a semitone, and we find
;;; ourselves in the uncanny valley of microtonal voice leading.

;;; I've never developed an ear for microtonal music, so I'll run with
;;; the idea of this pivoting around the octave and try something
;;; conventional.  Take the same two chords, add a minor chord on the
;;; tonic (without the 8/7 offset) before, and its reflection around
;;; the next octave after. Then tack on a little ending to make a more
;;; satisfying musical snippet: move down by a fourth, then back, with
;;; a couple added notes for color.

#+HUSH
(let ((*tonic* 196.0)
      (*len* 2))
  (play
   (seq
    (chord ()                           ; 1
      (just (1) (1))
      (just (6) (5))
      (just (3) (2)))
    (chord ()                           ; 2
      (just (8  ) (  7))
      (just (8 5) (4 7))
      (just (8 3) (2 7)))
    (chord ()                           ; 3: Built downward from next octave, symmetric with 2.
      (just (2 7 2) (3 8))
      (just (2 7 4) (5 8))
      (just (2 7 1) (1 8)))
    (chord ()                           ; 4: Built downward from next octave, symmetric with 1.
      (just (2  ) (1))
      (just (2 5) (6))
      (just (2 2) (3)))

    ;; Build and release tension.
    (chord ((*len* 3))
      (just (2 3  ) (  4))
      (just (2 3 4) (3 4))
      (just (2 3 3) (2 4)))
    (chord ((*len* 1))
      (just (2 3  )   (    4))
      (just (2 3 4)   (  3 4))
      (just (2 3 3)   (  2 4))
      (just (2 3 4 4) (3 3 4)))         ; 4/3*4/3, let's call it a dominant seventh.
    (chord ((*len* 4))
      (just (1) (1))
      (just (6) (5))
      (just (3) (2))
      (just (2) (1))
      (just (3) (1))))))                ; ..and that's a ninth. The 7th resolved here.

;;; Stacking fourths:
#+HUSH
(let ((*tonic* 262.0)
      (*len* 2))
  (play
   (seq
    (chord ()
      (just (1) (1))
      (just (4) (3)))
    (chord ()
      (just (   ) (   ))                ; Did I mention the ones are optional?
      (just (4  ) (  3))
      (just (4 4) (3 3)))
    (chord ()
      (just (     ) (     ))
      (just (4    ) (    3))
      (just (4 4  ) (  3 3))
      (just (4 4 4) (3 3 3)))
    (chord ()
      (just (       ) (       ))
      (just (4      ) (      3))
      (just (4 4    ) (    3 3))
      (just (4 4 4  ) (  3 3 3))
      (just (4 4 4 4) (3 3 3 3)))
    (chord ()
      (just (         ) (         ))
      (just (4        ) (        3))
      (just (4 4      ) (      3 3))
      (just (4 4 4    ) (    3 3 3))
      (just (4 4 4 4  ) (  3 3 3 3))
      (just (4 4 4 4 4) (3 3 3 3 3))))))

;;; Fifths and fourths.
#+HUSH
(let ((*tonic* 262.0)
      (*len* 1))
  (play
   (seq
    (chord ()
      (just (   ) (   ))
      (just (3  ) (  2))
      (just (3 4) (3 2)))
    (chord ()
      (just (   ) (   ))
      (just (4  ) (  3))
      (just (4 4) (3 3)))
    (chord ((*len* 2))
      (just (     ) (     ))
      (just (3    ) (    2))
      (just (3 3  ) (  4 2))
      (just (3 3 4) (3 4 2)))
    (chord ()
      (just (     ) (     ))
      (just (4    ) (    3))
      (just (4 4  ) (  3 3))
      (just (4 4 4) (3 3 3)))
    (chord ()
      (just (     ) (     ))
      (just (3    ) (    2))
      (just (3 4  ) (  3 2))
      (just (3 4 4) (3 3 2)))
    (chord ((*len* 4))
      (just (     ) (     ))
      (just (4    ) (    3))
      (just (4 3  ) (  2 3))
      (just (4 3 4) (3 2 3))))))

;;; Various ways to express the same major chord:
#+HUSH
(play
 (seq
  (chord ()                             ; Three separate notes.
    (just (1) (1))
    (just (5) (4))
    (just (3) (2)))
  (chord ()
    (just (1    ) (    1))
    (just (1 5  ) (  4 1))              ; A major 3rd..
    (just (1 5 6) (5 4 1)))             ; ..and a minor 3rd on top of that.
  (chord ()
    (just (1    ) (    1))
    (just (1 3  ) (  2 1))              ; Or, you could nest the third inside
    (just (1 3 5) (6 2 1)))))           ; the fifth by a downward interval.


;;; The Tristan Chord (equal temperament):
#+HUSH
(play
 (chord ((*tonic* 349.0)                ; F
         (*len* 3))
   (tone (* *tonic* (print (expt 2.0  0/12))))
   (tone (* *tonic* (print (expt 2.0  6/12))))
   (tone (* *tonic* (print (expt 2.0 10/12))))
   (tone (* *tonic* (print (expt 2.0 15/12))))))

;;; Assume we're in A minor, and the chord is inverted such that the
;;; root is B.  The tritone between B and F is problematic. It's an
;;; unnatural interval in just-intonation, and there are various ways
;;; to interpret it relative to the other notes.
#+NIL
(play
 (chord ((*tonic* 440.0)
         (*len* 3))
   (just (9    ) (    8))               ; B
   (just (9 5  ) (  4 8))               ; B * 5/4 = D#
   (just (9 5 4) (3 4 8))               ; D * 4/3 = G#

   ;; Now we need that F. Three ways to get there spring to mind:

   ;; 1. Two intervals of 3/4 downward from D#. Yields intervals of
   ;; 45/64, 9/16, and 27/64 versus the other notes in the chord, and
   ;; an ungainly 405/512 versus the tonic. The ratios are ugly, but
   ;; the sound is quite close.
   ;; (just (9 5 9) (16 4 8))

   ;; 2. An intervals of 5/9 downward from D# yields intervals of
   ;; 25/36, 5/9, and 5/12 versus the rest of the chord, and 25/32
   ;; against the tonic. The pitch ratios within the chord are mostly
   ;; nice and simple, but the F sounds oddly flat.
   ;; (just (9 5 5) (9 4 8))

   ;; 3. An interval of 7/10 downward from the root, yielding
   ;; intervals of 7/10, 14/25, and 21/50 versus the rest of the
   ;; chord, and 63/80 against the tonic. Constructing the F relative
   ;; to the root of the chord seems preferable, even if it introduces
   ;; a new factor of 7 into the ratios, which make the intervals
   ;; against D# and G# odd. Overall, I prefer the sound of this
   ;; one. The F is slightly flat compared to the equal-tempered
   ;; chord, but not unpleasantly so.
   (just (9 7) (10 8))))

;;; When you uncomment more than one of the above versions of 'F',
;;; they're slightly detuned and beat against each other. This could be
;;; a cool compositional device to highlight shifts in the tonality.
;;; I'll try it with the two Partch chords:
#+HUSH
(let ((*tonic* 196.0)
      (*len* 3))
 (play
  (repeat 2
    (seq
     (chord ()
       (just   (8 1) (1 7))
       (just   (8 5) (4 7))
       (just   (8 3) (2 7)))
     (chord ()
       (just   (8 1) (1 7))
       (just   (8 5) (4 7))
       (just (2 7 4) (5 8 1))           ; Presages the following chord..
       (just   (8 3) (2 7)))
     (chord ()
       (just (2 7 1) (1 8 1))
       (just (2 7 4) (5 8 1))
       (just (2 7 2) (3 8 1)))
     (chord ()
       (just (2 7 1) (1 8 1))
       (just (2 7 4) (5 8 1))
       (just   (8 5) (4 7))             ; And again..
       (just (2 7 2) (3 8 1)))))))

;; That suggests a more subtle trick. Rather than playing both tones
;; to mark the shift, replace one with the similar tone from the next
;; chord.
#+HUSH
(let ((*tonic* 196.0)
      (*len* 3))
 (play
  (repeat 2
    (seq
     (chord ()
       (just   (8 1) (1 7))
       (just   (8 5) (4 7))
       (just   (8 3) (2 7)))
     (chord ()
       (just   (8 1) (1 7))
       (just (2 7 4) (5 8 1))           ; Replaced (8 5) (4 7) to lead into the next chord.
       (just   (8 3) (2 7)))
     (chord ()
       (just (2 7 1) (1 8 1))
       (just (2 7 4) (5 8 1))
       (just (2 7 2) (3 8 1)))
     (chord ()
       (just (2 7 1) (1 8 1))
       (just   (8 5) (4 7))             ; Likewise, replaced (2 7 4) (5 8 1)
       (just (2 7 2) (3 8 1)))))))

;;; That's all for now.