Microtonal notation in Lilypond using Helmholtz/Ellis notation
The Helmholtz-Ellis Just Intonation Pitch Notation (HEJI) maps precise comma inflections for just intonation up to the 47-limit onto Pythagorean base notes in LilyPond. For me personally it is easier to think about these pithces as ratios rather than as combination of diatonic pitch names, Pythagorean accidentals and additional commas. For that reason I put together this code in scheme that takes a string of ratios and outputs a complete Lilypond score.
This is not meant to be a general set of functions that works for all contexts, it is mainly for my own use, but if there is an interest for it I will consider compiling it into a more user friendly format.
Calling the function eh-printer-music-only returns a music block for Lilypond with the ratios supplied as arguments as pitches (all quarter notes).
(use-modules (ice-9 format))
(define (eh-printer-music-only R octred T)
(begin
(format #t "~a = {\n ~a\n ~a\n" "music" "\\accidentalStyle \"dodecaphonic\"" "\\fixed c' {")
(map (lambda (R)
(format #t " ~a~a~a\n"
(car (note-name R octred T))
(car (ellis-notation R))
(car (cdr (ellis-notation R)))))
R)
(format #t " ~a\n~a\n\n" "}" "}")
)
)
(eh-printer-music-only '( 9/7 16/11 8/5 81/80 11/10 2/1) #t 0)
The following code must be available for the above to work:
(define (note-name R O transpose)
(let* ((oct (if (eq? #t O)
0
(cdr (octave-reduction R))))
(r (car (octave-reduction R)))
(c (* 1200 (log2 r)))
(p (retrieve-ellis-ext R))
(n (remainder (inexact->exact
(truncate
(/ (+ (abs c) 50) 100))) 12)))
(cons
;; correcting accidentals for 11 and 13
(cond ((eq? p 11) (car (cdr (assoc (modulo (+ (- n 1) transpose) 12) note-names))))
((eq? p 13) (car (cdr (assoc (modulo (+ (+ n 1) transpose) 12) note-names))))
(else (car (cdr (assoc (modulo (+ n transpose) 12) note-names)))))
(+ (truncate-quotient transpose 12) oct))
)
)
(define (simple-factorize x p)
(if (>= x (* p p))
(cond
[(eq? 0 (remainder x p)) (simple-factorize (/ x p) p)]
[else (simple-factorize x (+ p 1))]
)
x))
(simple-factorize 3 2)
(define (simple-factorize-m x p i)
(if (>= x (* p p))
(cond
[(eq? 0 (remainder x p)) (simple-factorize-m (/ x p) p (+ i 1))]
[else (simple-factorize-m x (+ p 1) i)]
)
(list x i)))
(define ellisO
'((1 "" 0)
(2 "" 0)
(3 "" 0)
(5 "oa" 21.5)
(7 "ob" 27.3)
(11 "oc" 53.3)
(13 "od" 65.3)
(17 "oe" 8.7))
)
(define ellisU
'((1 "")
(2 "")
(3 "")
(5 "ua")
(7 "ub")
(11 "uc")
(13 "ud")
(17 "ue"))
)
(define ellis_exp
'((0 "a")
(1 "b")
(2 "c")
(3 "d")
(4 "e")
))
(define (retrieve-ellis-ext R)
(let* ((p (apply max
(list
(simple-factorize (numerator R) 2)
(simple-factorize (denominator R) 2)
))
)
)
p)
)
(define (retrieve-ellis-exponent-p R)
(let* ((m (apply max
(list
(car (cdr (simple-factorize-m (numerator R) 2 0)))
(car (cdr (simple-factorize-m (denominator R) 2 0)))
))))
m)
)
(define (retrieve-ellis-exponent R)
(let* ((n (numerator R))
(d (simple-factorize (denominator R) 2))
(e 0))
;; is this 25/16 in some octave? ;;
(cond [(and (eq? n 25) (eq? d 2)) (set! e 1)]
;; is this 32/25 in some octave? ;;
[(and (eq? n 32) (eq? d 5)) (set! e 1)]
;; is this 128/125 in some octave? ;;
[(and (eq? n 128) (eq? d 5)) (set! e 2)]
;; is this 49/48 in some octave? ;;
[(and (eq? n 49) (eq? d 3)) (set! e 2)]
)
e)
)
;; call this to retrieve the right symbols from the tables below
(define (ellis-notation R)
(let* ((a (retrieve-ellis-ext R))
(b (retrieve-ellis-exponent R)))
(cond [(>= R 1)
(if (>= a 5)
(list (car (cdr (assoc a ellisO)))
(car (cdr (assoc b ellis_exp)))
(car (cdr (assoc a ellisO))))
(list (car (cdr (assoc a ellisO)))
"" 0))]
[(< R 1)
(if (>= a 5)
(list (car (cdr (assoc a ellisU))) (car (cdr (assoc b ellis_exp))))
(list (car (cdr (assoc a ellisU))) ""))]
)))
(define (octave-notation oct)
(if (and (> oct 0) (< oct 6))
(octaves oct "")
(if (and (< oct 0) (> oct -6))
(sub-octaves oct ""))))
(define (octaves oct s)
(if (<= oct 0)
s
(octaves (- oct 1) (string-append s "'"))))
(define (sub-octaves oct s)
(if (>= oct 0)
s
(sub-octaves (+ oct 1) (string-append s ","))))
(define (simple-factorize-m x p i)
(if (>= x (* p p))
(cond
[(eq? 0 (remainder x p)) (simple-factorize-m (/ x p) p (+ i 1))]
[else (simple-factorize-m x (+ p 1) i)]
)
(list x i)))
(define (simple-factorize x p)
(if (>= x (* p p))
(cond
[(eq? 0 (remainder x p)) (simple-factorize (/ x p) p)]
[else (simple-factorize x (+ p 1))]
)
x))
(simple-factorize 3 2)
(define (simple-factorize-m x p i)
(if (>= x (* p p))
(cond
[(eq? 0 (remainder x p)) (simple-factorize-m (/ x p) p (+ i 1))]
[else (simple-factorize-m x (+ p 1) i)]
)
(list x i)))
(define (simple-factorize x p)
(if (>= x (* p p))
(cond
[(eq? 0 (remainder x p)) (simple-factorize (/ x p) p)]
[else (simple-factorize x (+ p 1))]
)
x))
(simple-factorize 3 2)
(define (simple-factorize-m x p i)
(if (>= x (* p p))
(cond
[(eq? 0 (remainder x p)) (simple-factorize-m (/ x p) p (+ i 1))]
[else (simple-factorize-m x (+ p 1) i)]
)
(list x i)))
(define ellisO
'((1 "" 0)
(2 "" 0)
(3 "" 0)
(5 "oa" 21.5)
(7 "ob" 27.3)
(11 "oc" 53.3)
(13 "od" 65.3)
(17 "oe" 8.7))
)
(define ellisU
'((1 "")
(2 "")
(3 "")
(5 "ua")
(7 "ub")
(11 "uc")
(13 "ud")
(17 "ue"))
)
(define ellis_exp
'((0 "a")
(1 "b")
(2 "c")
(3 "d")
(4 "e")
))
(define (retrieve-ellis-ext R)
(let* ((p (apply max
(list
(simple-factorize (numerator R) 2)
(simple-factorize (denominator R) 2)
))
)
)
p)
)
(define (retrieve-ellis-exponent-p R)
(let* ((m (apply max
(list
(car (cdr (simple-factorize-m (numerator R) 2 0)))
(car (cdr (simple-factorize-m (denominator R) 2 0)))
))))
m)
)
(define (retrieve-ellis-exponent R)
(let* ((n (numerator R))
(d (simple-factorize (denominator R) 2))
(e 0))
;; is this 25/16 in some octave? ;;
(cond [(and (eq? n 25) (eq? d 2)) (set! e 1)]
;; is this 32/25 in some octave? ;;
[(and (eq? n 32) (eq? d 5)) (set! e 1)]
;; is this 128/125 in some octave? ;;
[(and (eq? n 128) (eq? d 5)) (set! e 2)]
;; is this 49/48 in some octave? ;;
[(and (eq? n 49) (eq? d 3)) (set! e 2)]
)
e)
)
;; call this to retrieve the right symbols from the tables below
(define (ellis-notation R)
(let* ((a (retrieve-ellis-ext R))
(b (retrieve-ellis-exponent R)))
(cond [(>= R 1)
(if (>= a 5)
(list (car (cdr (assoc a ellisO)))
(car (cdr (assoc b ellis_exp)))
(car (cdr (assoc a ellisO))))
(list (car (cdr (assoc a ellisO)))
"" 0))]
[(< R 1)
(if (>= a 5)
(list (car (cdr (assoc a ellisU))) (car (cdr (assoc b ellis_exp))))
(list (car (cdr (assoc a ellisU))) ""))]
)))
(define ellisO
'((1 "" 0)
(2 "" 0)
(3 "" 0)
(5 "oa" 21.5)
(7 "ob" 27.3)
(11 "oc" 53.3)
(13 "od" 65.3)
(17 "oe" 8.7))
)
(define ellisU
'((1 "")
(2 "")
(3 "")
(5 "ua")
(7 "ub")
(11 "uc")
(13 "ud")
(17 "ue"))
)
(define ellis_exp
'((0 "a")
(1 "b")
(2 "c")
(3 "d")
(4 "e")
))