Diatonic/modal transposition function

[John Mandereau]

Hello,
This email is a follow-up to
http://lists.gnu.org/archive/html/lilypond-user/2008-12/msg00591.html
I started a new thread because I'm finally not sure whether the code
below answers the initial question.

I finally managed to write, debug, clean up and document diatonic
transposition functions.  Here is the full code with some examples
below.  There are two end-user functions, the generic modeTranspose and
a shortcut diatonicTranspose.

All these functions except degree-transpose are currently limited to
scales and modes of length 7; using scales with different length
requires a pitch representation that separates notions of degree and
note name, that is, it requires scales definitions different from those
currently in ly/scale-definitions-init.ly and more complex functions for
converting between LilyPond pitch representation and "modal" pitch
representation.

Please comment the function names and syntax, the Scheme code or
whatever.  If there is enough interest in using these, I'll write
additional documentation and submit a patch for requesting inclusion in
LilyPond 2.12.x; otherwise I'll add this on LSR.

Enjoy!

#(define (true-quotient n d)
  "Return the one true quotient in integer division of n by d, i.e.
return the integer q so that there is a unique integer r that
satisfies  n = qd + r  and  0 <= r < |d|"
  (if (>= n 0)
   (quotient n d)
   (- (quotient n d) 1)))

#(define (ly-pitch->modal-pitch ly-pitch scale tonic-c-diff)
  "Convert ly-pitch to a list (octave degree depresentation) which represents
the modal pitch in scale, with tonic-c-diff as the pitch diff from tonic to
middle C.  scale should be a notename->alteration alist of length 7 which
represents the alteration of each note with C as first pitch of the scale."
  (let* ((normalized-pitch (ly:pitch-transpose ly-pitch tonic-c-diff))
         (notename (ly:pitch-notename normalized-pitch)))
   (list
    (ly:pitch-octave normalized-pitch) ;; octave
    notename ;; degree
    ;; alteration
    (- (ly:pitch-alteration normalized-pitch) (ly:assoc-get notename scale)))))

#(define (degree-transpose modal-pitch degree-delta scale-length)
"Transpose modal-pitch (octave degree alteration) by degree-delta assuming
scale-length."
  (let* ((octave (car modal-pitch))
         (degree (cadr modal-pitch))
         (alteration (caddr modal-pitch))
         (relative-new-degree (+ degree degree-delta)))
   (list
    (+ octave (true-quotient relative-new-degree scale-length))
    (modulo relative-new-degree scale-length)
    alteration)))

#(define (modal-pitch->ly-pitch modal-pitch scale c-tonic-diff)
  "Convert modal-pitch -- a list (octave degree alteration) -- to a
standard pitch using scale and pitch diff from middle C to tonic.
scale should be a notename->alteration alist of length 7 which represents
the alteration of each note with C as first pitch of the scale."
  (let* ((octave (car modal-pitch))
         (degree (min 6 (cadr modal-pitch)))
         (alteration (caddr modal-pitch))
         (abs-alteration (+ alteration (ly:assoc-get degree scale))))
   (ly:pitch-transpose
    (ly:make-pitch octave degree abs-alteration)
    c-tonic-diff)))

#(define (lookup-music-property event type)
  "Return the first music property of the given type found in event,
or #f is no such property is found.  event should be music or a list
of music."
  (if (null? event)
   #f
   (if (list? event)
    (or
     (lookup-music-property (car event) type)
     (lookup-music-property (cdr event) type))
    (let ((p (ly:music-property event 'pitch)))
     (if (not (null? p))
      p
      (let* ((e (ly:music-property event 'element))
             (es (ly:music-property event 'elements))
             (p2 (if (null? e)
                  '()
                  (lookup-music-property e type))))
       (if (not (null? p2))
        p2
        (lookup-music-property es type))))))))

#(define (mode-transpose
          pitch-note1 scale1 degree-delta pitch-note2 scale2 music)
  (let ((tonic-diff1 (ly:pitch-diff
                      (ly:make-pitch 0 0 0)
                      (lookup-music-property pitch-note1 'pitch)))
        (tonic-diff2 (ly:pitch-diff
                      (lookup-music-property pitch-note2 'pitch)
                      (ly:make-pitch 0 0 0))))
   (music-map
    (lambda (event)
     (let ((p (ly:music-property event 'pitch)))
      (if (ly:pitch? p)
       (ly:music-set-property!
        event
        'pitch
        (modal-pitch->ly-pitch
         (degree-transpose
          (ly-pitch->modal-pitch p scale1 tonic-diff1)
          degree-delta
          (length scale1))
         scale2
         tonic-diff2)))
      event))
    music)))

modeTranspose =
#(define-music-function
  (parser location pitch-note1 scale1 degree-delta pitch-note2 scale2 music)
  (ly:music? list? number? ly:music? list? ly:music?)
  "Transpose music from scale1 on tonic pitch-note1
by degree-delta to scale2 on tonic pitch-note2."
  (mode-transpose
   pitch-note1 scale1 degree-delta pitch-note2 scale2 music))

diatonicTranspose =
#(define-music-function
  (parser location pitch-note scale degree-delta music)
  (ly:music? list? number? ly:music?)
  "Transpose music by degree-delta in scale on tonic pitch-note."
  (mode-transpose
   pitch-note scale degree-delta pitch-note scale music))

pattern = \relative c' { c2~ c8 d16 e f g a b c4 g e c }

\transpose c g \new Staff {
  \pattern
  \diatonicTranspose c \major #1 \pattern % I -> II
  \diatonicTranspose c \major #2 \pattern % I -> III
}

% mix between lydian and mixolydian
milydian = #`(
  (0 . 0)
  (1 . 0)
  (2 . 0)
  (3 . ,SHARP)
  (4 . 0)
  (5 . 0)
  (6 . ,FLAT))

melodie = \relative c' { \times 2/3 { cis8 d e } f2 }

\new Staff {
  \time 3/4
  \melodie
  \modeTranspose g \milydian #-3 d' \lydian \melodie % IV -> I
  \modeTranspose g \milydian #3 e' \lydian \melodie % IV -> VII
}

-- 
John Mandereau <address@hidden>